(mac_dialog_modal_filter, Fx_popup_dialog) [MAC_OSX]:
[emacs.git] / src / macmenu.c
blob6fe064dd55a6de688d8fe58f15e4b33f508f312e
1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007 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 enum mac_menu_kind { /* Menu ID range */
66 MAC_MENU_APPLE, /* 0 (Reserved by Apple) */
67 MAC_MENU_MENU_BAR, /* 1 .. 233 */
68 MAC_MENU_M_APPLE, /* 234 (== M_APPLE) */
69 MAC_MENU_POPUP, /* 235 */
70 MAC_MENU_DRIVER, /* 236 .. 255 (Reserved) */
71 MAC_MENU_MENU_BAR_SUB, /* 256 .. 16383 */
72 MAC_MENU_POPUP_SUB, /* 16384 .. 32767 */
73 MAC_MENU_END /* 32768 */
76 static const int min_menu_id[] = {0, 1, 234, 235, 236, 256, 16384, 32768};
78 #define DIALOG_WINDOW_RESOURCE 130
80 #if TARGET_API_MAC_CARBON
81 #define HAVE_DIALOGS 1
82 #endif
84 #undef HAVE_MULTILINGUAL_MENU
86 /******************************************************************/
87 /* Definitions copied from lwlib.h */
89 typedef void * XtPointer;
91 enum button_type
93 BUTTON_TYPE_NONE,
94 BUTTON_TYPE_TOGGLE,
95 BUTTON_TYPE_RADIO
98 /* This structure is based on the one in ../lwlib/lwlib.h, modified
99 for Mac OS. */
100 typedef struct _widget_value
102 /* name of widget */
103 Lisp_Object lname;
104 char* name;
105 /* value (meaning depend on widget type) */
106 char* value;
107 /* keyboard equivalent. no implications for XtTranslations */
108 Lisp_Object lkey;
109 char* key;
110 /* Help string or nil if none.
111 GC finds this string through the frame's menu_bar_vector
112 or through menu_items. */
113 Lisp_Object help;
114 /* true if enabled */
115 Boolean enabled;
116 /* true if selected */
117 Boolean selected;
118 /* The type of a button. */
119 enum button_type button_type;
120 /* true if menu title */
121 Boolean title;
122 #if 0
123 /* true if was edited (maintained by get_value) */
124 Boolean edited;
125 /* true if has changed (maintained by lw library) */
126 change_type change;
127 /* true if this widget itself has changed,
128 but not counting the other widgets found in the `next' field. */
129 change_type this_one_change;
130 #endif
131 /* Contents of the sub-widgets, also selected slot for checkbox */
132 struct _widget_value* contents;
133 /* data passed to callback */
134 XtPointer call_data;
135 /* next one in the list */
136 struct _widget_value* next;
137 #if 0
138 /* slot for the toolkit dependent part. Always initialize to NULL. */
139 void* toolkit_data;
140 /* tell us if we should free the toolkit data slot when freeing the
141 widget_value itself. */
142 Boolean free_toolkit_data;
144 /* we resource the widget_value structures; this points to the next
145 one on the free list if this one has been deallocated.
147 struct _widget_value *free_list;
148 #endif
149 } widget_value;
151 /* Assumed by other routines to zero area returned. */
152 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
153 0, (sizeof (widget_value)))
154 #define free_widget_value(wv) xfree (wv)
156 /******************************************************************/
158 #ifndef TRUE
159 #define TRUE 1
160 #define FALSE 0
161 #endif /* no TRUE */
163 Lisp_Object Qdebug_on_next_call;
165 extern Lisp_Object Vmenu_updating_frame;
167 extern Lisp_Object Qmenu_bar, Qmac_apple_event;
169 extern Lisp_Object QCtoggle, QCradio;
171 extern Lisp_Object Voverriding_local_map;
172 extern Lisp_Object Voverriding_local_map_menu_flag;
174 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
176 extern Lisp_Object Qmenu_bar_update_hook;
178 void set_frame_menubar P_ ((FRAME_PTR, int, int));
180 #if TARGET_API_MAC_CARBON
181 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
182 #else
183 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
184 #endif
186 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
187 Lisp_Object, Lisp_Object, Lisp_Object,
188 Lisp_Object, Lisp_Object));
189 #ifdef HAVE_DIALOGS
190 static Lisp_Object mac_dialog_show P_ ((FRAME_PTR, int, Lisp_Object,
191 Lisp_Object, char **));
192 #endif
193 static Lisp_Object mac_menu_show P_ ((struct frame *, int, int, int, int,
194 Lisp_Object, char **));
195 static void keymap_panes P_ ((Lisp_Object *, int, int));
196 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
197 int, int));
198 static void list_of_panes P_ ((Lisp_Object));
199 static void list_of_items P_ ((Lisp_Object));
201 static void find_and_call_menu_selection P_ ((FRAME_PTR, int, Lisp_Object,
202 void *));
203 static int fill_menu P_ ((MenuRef, widget_value *, enum mac_menu_kind, int));
204 static void fill_menubar P_ ((widget_value *, int));
205 static void dispose_menus P_ ((enum mac_menu_kind, int));
208 /* This holds a Lisp vector that holds the results of decoding
209 the keymaps or alist-of-alists that specify a menu.
211 It describes the panes and items within the panes.
213 Each pane is described by 3 elements in the vector:
214 t, the pane name, the pane's prefix key.
215 Then follow the pane's items, with 5 elements per item:
216 the item string, the enable flag, the item's value,
217 the definition, and the equivalent keyboard key's description string.
219 In some cases, multiple levels of menus may be described.
220 A single vector slot containing nil indicates the start of a submenu.
221 A single vector slot containing lambda indicates the end of a submenu.
222 The submenu follows a menu item which is the way to reach the submenu.
224 A single vector slot containing quote indicates that the
225 following items should appear on the right of a dialog box.
227 Using a Lisp vector to hold this information while we decode it
228 takes care of protecting all the data from GC. */
230 #define MENU_ITEMS_PANE_NAME 1
231 #define MENU_ITEMS_PANE_PREFIX 2
232 #define MENU_ITEMS_PANE_LENGTH 3
234 enum menu_item_idx
236 MENU_ITEMS_ITEM_NAME = 0,
237 MENU_ITEMS_ITEM_ENABLE,
238 MENU_ITEMS_ITEM_VALUE,
239 MENU_ITEMS_ITEM_EQUIV_KEY,
240 MENU_ITEMS_ITEM_DEFINITION,
241 MENU_ITEMS_ITEM_TYPE,
242 MENU_ITEMS_ITEM_SELECTED,
243 MENU_ITEMS_ITEM_HELP,
244 MENU_ITEMS_ITEM_LENGTH
247 static Lisp_Object menu_items;
249 /* Number of slots currently allocated in menu_items. */
250 static int menu_items_allocated;
252 /* This is the index in menu_items of the first empty slot. */
253 static int menu_items_used;
255 /* The number of panes currently recorded in menu_items,
256 excluding those within submenus. */
257 static int menu_items_n_panes;
259 /* Current depth within submenus. */
260 static int menu_items_submenu_depth;
262 /* Nonzero means a menu is currently active. */
263 static int popup_activated_flag;
265 /* This is set nonzero after the user activates the menu bar, and set
266 to zero again after the menu bars are redisplayed by prepare_menu_bar.
267 While it is nonzero, all calls to set_frame_menubar go deep.
269 I don't understand why this is needed, but it does seem to be
270 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
272 int pending_menu_activation;
274 /* Initialize the menu_items structure if we haven't already done so.
275 Also mark it as currently empty. */
277 static void
278 init_menu_items ()
280 if (NILP (menu_items))
282 menu_items_allocated = 60;
283 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
286 menu_items_used = 0;
287 menu_items_n_panes = 0;
288 menu_items_submenu_depth = 0;
291 /* Call at the end of generating the data in menu_items. */
293 static void
294 finish_menu_items ()
298 /* Call when finished using the data for the current menu
299 in menu_items. */
301 static void
302 discard_menu_items ()
304 /* Free the structure if it is especially large.
305 Otherwise, hold on to it, to save time. */
306 if (menu_items_allocated > 200)
308 menu_items = Qnil;
309 menu_items_allocated = 0;
313 /* This undoes save_menu_items, and it is called by the specpdl unwind
314 mechanism. */
316 static Lisp_Object
317 restore_menu_items (saved)
318 Lisp_Object saved;
320 menu_items = XCAR (saved);
321 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
322 saved = XCDR (saved);
323 menu_items_used = XINT (XCAR (saved));
324 saved = XCDR (saved);
325 menu_items_n_panes = XINT (XCAR (saved));
326 saved = XCDR (saved);
327 menu_items_submenu_depth = XINT (XCAR (saved));
328 return Qnil;
331 /* Push the whole state of menu_items processing onto the specpdl.
332 It will be restored when the specpdl is unwound. */
334 static void
335 save_menu_items ()
337 Lisp_Object saved = list4 (menu_items,
338 make_number (menu_items_used),
339 make_number (menu_items_n_panes),
340 make_number (menu_items_submenu_depth));
341 record_unwind_protect (restore_menu_items, saved);
342 menu_items = Qnil;
345 /* Make the menu_items vector twice as large. */
347 static void
348 grow_menu_items ()
350 Lisp_Object old;
351 int old_size = menu_items_allocated;
352 old = menu_items;
354 menu_items_allocated *= 2;
356 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
357 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
358 old_size * sizeof (Lisp_Object));
361 /* Begin a submenu. */
363 static void
364 push_submenu_start ()
366 if (menu_items_used + 1 > menu_items_allocated)
367 grow_menu_items ();
369 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
370 menu_items_submenu_depth++;
373 /* End a submenu. */
375 static void
376 push_submenu_end ()
378 if (menu_items_used + 1 > menu_items_allocated)
379 grow_menu_items ();
381 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
382 menu_items_submenu_depth--;
385 /* Indicate boundary between left and right. */
387 static void
388 push_left_right_boundary ()
390 if (menu_items_used + 1 > menu_items_allocated)
391 grow_menu_items ();
393 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
396 /* Start a new menu pane in menu_items.
397 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
399 static void
400 push_menu_pane (name, prefix_vec)
401 Lisp_Object name, prefix_vec;
403 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
404 grow_menu_items ();
406 if (menu_items_submenu_depth == 0)
407 menu_items_n_panes++;
408 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
409 XVECTOR (menu_items)->contents[menu_items_used++] = name;
410 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
413 /* Push one menu item into the current pane. NAME is the string to
414 display. ENABLE if non-nil means this item can be selected. KEY
415 is the key generated by choosing this item, or nil if this item
416 doesn't really have a definition. DEF is the definition of this
417 item. EQUIV is the textual description of the keyboard equivalent
418 for this item (or nil if none). TYPE is the type of this menu
419 item, one of nil, `toggle' or `radio'. */
421 static void
422 push_menu_item (name, enable, key, def, equiv, type, selected, help)
423 Lisp_Object name, enable, key, def, equiv, type, selected, help;
425 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
426 grow_menu_items ();
428 XVECTOR (menu_items)->contents[menu_items_used++] = name;
429 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
430 XVECTOR (menu_items)->contents[menu_items_used++] = key;
431 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
432 XVECTOR (menu_items)->contents[menu_items_used++] = def;
433 XVECTOR (menu_items)->contents[menu_items_used++] = type;
434 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
435 XVECTOR (menu_items)->contents[menu_items_used++] = help;
438 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
439 and generate menu panes for them in menu_items.
440 If NOTREAL is nonzero,
441 don't bother really computing whether an item is enabled. */
443 static void
444 keymap_panes (keymaps, nmaps, notreal)
445 Lisp_Object *keymaps;
446 int nmaps;
447 int notreal;
449 int mapno;
451 init_menu_items ();
453 /* Loop over the given keymaps, making a pane for each map.
454 But don't make a pane that is empty--ignore that map instead.
455 P is the number of panes we have made so far. */
456 for (mapno = 0; mapno < nmaps; mapno++)
457 single_keymap_panes (keymaps[mapno],
458 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
460 finish_menu_items ();
463 /* Args passed between single_keymap_panes and single_menu_item. */
464 struct skp
466 Lisp_Object pending_maps;
467 int maxdepth, notreal;
470 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
471 void *));
473 /* This is a recursive subroutine of keymap_panes.
474 It handles one keymap, KEYMAP.
475 The other arguments are passed along
476 or point to local variables of the previous function.
477 If NOTREAL is nonzero, only check for equivalent key bindings, don't
478 evaluate expressions in menu items and don't make any menu.
480 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
482 static void
483 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
484 Lisp_Object keymap;
485 Lisp_Object pane_name;
486 Lisp_Object prefix;
487 int notreal;
488 int maxdepth;
490 struct skp skp;
491 struct gcpro gcpro1;
493 skp.pending_maps = Qnil;
494 skp.maxdepth = maxdepth;
495 skp.notreal = notreal;
497 if (maxdepth <= 0)
498 return;
500 push_menu_pane (pane_name, prefix);
502 GCPRO1 (skp.pending_maps);
503 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
504 UNGCPRO;
506 /* Process now any submenus which want to be panes at this level. */
507 while (CONSP (skp.pending_maps))
509 Lisp_Object elt, eltcdr, string;
510 elt = XCAR (skp.pending_maps);
511 eltcdr = XCDR (elt);
512 string = XCAR (eltcdr);
513 /* We no longer discard the @ from the beginning of the string here.
514 Instead, we do this in mac_menu_show. */
515 single_keymap_panes (Fcar (elt), string,
516 XCDR (eltcdr), notreal, maxdepth - 1);
517 skp.pending_maps = XCDR (skp.pending_maps);
521 /* This is a subroutine of single_keymap_panes that handles one
522 keymap entry.
523 KEY is a key in a keymap and ITEM is its binding.
524 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
525 separate panes.
526 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
527 evaluate expressions in menu items and don't make any menu.
528 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
530 static void
531 single_menu_item (key, item, dummy, skp_v)
532 Lisp_Object key, item, dummy;
533 void *skp_v;
535 Lisp_Object map, item_string, enabled;
536 struct gcpro gcpro1, gcpro2;
537 int res;
538 struct skp *skp = skp_v;
540 /* Parse the menu item and leave the result in item_properties. */
541 GCPRO2 (key, item);
542 res = parse_menu_item (item, skp->notreal, 0);
543 UNGCPRO;
544 if (!res)
545 return; /* Not a menu item. */
547 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
549 if (skp->notreal)
551 /* We don't want to make a menu, just traverse the keymaps to
552 precompute equivalent key bindings. */
553 if (!NILP (map))
554 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
555 return;
558 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
559 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
561 if (!NILP (map) && SREF (item_string, 0) == '@')
563 if (!NILP (enabled))
564 /* An enabled separate pane. Remember this to handle it later. */
565 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
566 skp->pending_maps);
567 return;
570 push_menu_item (item_string, enabled, key,
571 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
572 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
573 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
574 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
575 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
577 /* Display a submenu using the toolkit. */
578 if (! (NILP (map) || NILP (enabled)))
580 push_submenu_start ();
581 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
582 push_submenu_end ();
586 /* Push all the panes and items of a menu described by the
587 alist-of-alists MENU.
588 This handles old-fashioned calls to x-popup-menu. */
590 static void
591 list_of_panes (menu)
592 Lisp_Object menu;
594 Lisp_Object tail;
596 init_menu_items ();
598 for (tail = menu; CONSP (tail); tail = XCDR (tail))
600 Lisp_Object elt, pane_name, pane_data;
601 elt = XCAR (tail);
602 pane_name = Fcar (elt);
603 CHECK_STRING (pane_name);
604 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
605 pane_data = Fcdr (elt);
606 CHECK_CONS (pane_data);
607 list_of_items (pane_data);
610 finish_menu_items ();
613 /* Push the items in a single pane defined by the alist PANE. */
615 static void
616 list_of_items (pane)
617 Lisp_Object pane;
619 Lisp_Object tail, item, item1;
621 for (tail = pane; CONSP (tail); tail = XCDR (tail))
623 item = XCAR (tail);
624 if (STRINGP (item))
625 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
626 Qnil, Qnil, Qnil, Qnil);
627 else if (CONSP (item))
629 item1 = XCAR (item);
630 CHECK_STRING (item1);
631 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
632 Qt, Qnil, Qnil, Qnil, Qnil);
634 else
635 push_left_right_boundary ();
640 static Lisp_Object
641 cleanup_popup_menu (arg)
642 Lisp_Object arg;
644 discard_menu_items ();
645 return Qnil;
648 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
649 doc: /* Pop up a deck-of-cards menu and return user's selection.
650 POSITION is a position specification. This is either a mouse button event
651 or a list ((XOFFSET YOFFSET) WINDOW)
652 where XOFFSET and YOFFSET are positions in pixels from the top left
653 corner of WINDOW. (WINDOW may be a window or a frame object.)
654 This controls the position of the top left of the menu as a whole.
655 If POSITION is t, it means to use the current mouse position.
657 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
658 The menu items come from key bindings that have a menu string as well as
659 a definition; actually, the "definition" in such a key binding looks like
660 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
661 the keymap as a top-level element.
663 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
664 Otherwise, REAL-DEFINITION should be a valid key binding definition.
666 You can also use a list of keymaps as MENU.
667 Then each keymap makes a separate pane.
669 When MENU is a keymap or a list of keymaps, the return value is the
670 list of events corresponding to the user's choice. Note that
671 `x-popup-menu' does not actually execute the command bound to that
672 sequence of events.
674 Alternatively, you can specify a menu of multiple panes
675 with a list of the form (TITLE PANE1 PANE2...),
676 where each pane is a list of form (TITLE ITEM1 ITEM2...).
677 Each ITEM is normally a cons cell (STRING . VALUE);
678 but a string can appear as an item--that makes a nonselectable line
679 in the menu.
680 With this form of menu, the return value is VALUE from the chosen item.
682 If POSITION is nil, don't display the menu at all, just precalculate the
683 cached information about equivalent key sequences.
685 If the user gets rid of the menu without making a valid choice, for
686 instance by clicking the mouse away from a valid choice or by typing
687 keyboard input, then this normally results in a quit and
688 `x-popup-menu' does not return. But if POSITION is a mouse button
689 event (indicating that the user invoked the menu with the mouse) then
690 no quit occurs and `x-popup-menu' returns nil. */)
691 (position, menu)
692 Lisp_Object position, menu;
694 Lisp_Object keymap, tem;
695 int xpos = 0, ypos = 0;
696 Lisp_Object title;
697 char *error_name = NULL;
698 Lisp_Object selection;
699 FRAME_PTR f = NULL;
700 Lisp_Object x, y, window;
701 int keymaps = 0;
702 int for_click = 0;
703 int specpdl_count = SPECPDL_INDEX ();
704 struct gcpro gcpro1;
706 #ifdef HAVE_MENUS
707 if (! NILP (position))
709 check_mac ();
711 /* Decode the first argument: find the window and the coordinates. */
712 if (EQ (position, Qt)
713 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
714 || EQ (XCAR (position), Qtool_bar)
715 || EQ (XCAR (position), Qmac_apple_event))))
717 /* Use the mouse's current position. */
718 FRAME_PTR new_f = SELECTED_FRAME ();
719 Lisp_Object bar_window;
720 enum scroll_bar_part part;
721 unsigned long time;
723 if (mouse_position_hook)
724 (*mouse_position_hook) (&new_f, 1, &bar_window,
725 &part, &x, &y, &time);
726 if (new_f != 0)
727 XSETFRAME (window, new_f);
728 else
730 window = selected_window;
731 XSETFASTINT (x, 0);
732 XSETFASTINT (y, 0);
735 else
737 tem = Fcar (position);
738 if (CONSP (tem))
740 window = Fcar (Fcdr (position));
741 x = XCAR (tem);
742 y = Fcar (XCDR (tem));
744 else
746 for_click = 1;
747 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
748 window = Fcar (tem); /* POSN_WINDOW (tem) */
749 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
750 x = Fcar (tem);
751 y = Fcdr (tem);
755 CHECK_NUMBER (x);
756 CHECK_NUMBER (y);
758 /* Decode where to put the menu. */
760 if (FRAMEP (window))
762 f = XFRAME (window);
763 xpos = 0;
764 ypos = 0;
766 else if (WINDOWP (window))
768 CHECK_LIVE_WINDOW (window);
769 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
771 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
772 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
774 else
775 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
776 but I don't want to make one now. */
777 CHECK_WINDOW (window);
779 xpos += XINT (x);
780 ypos += XINT (y);
782 XSETFRAME (Vmenu_updating_frame, f);
784 else
785 Vmenu_updating_frame = Qnil;
786 #endif /* HAVE_MENUS */
788 title = Qnil;
789 GCPRO1 (title);
791 /* Decode the menu items from what was specified. */
793 keymap = get_keymap (menu, 0, 0);
794 if (CONSP (keymap))
796 /* We were given a keymap. Extract menu info from the keymap. */
797 Lisp_Object prompt;
799 /* Extract the detailed info to make one pane. */
800 keymap_panes (&menu, 1, NILP (position));
802 /* Search for a string appearing directly as an element of the keymap.
803 That string is the title of the menu. */
804 prompt = Fkeymap_prompt (keymap);
805 if (NILP (title) && !NILP (prompt))
806 title = prompt;
808 /* Make that be the pane title of the first pane. */
809 if (!NILP (prompt) && menu_items_n_panes >= 0)
810 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
812 keymaps = 1;
814 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
816 /* We were given a list of keymaps. */
817 int nmaps = XFASTINT (Flength (menu));
818 Lisp_Object *maps
819 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
820 int i;
822 title = Qnil;
824 /* The first keymap that has a prompt string
825 supplies the menu title. */
826 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
828 Lisp_Object prompt;
830 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
832 prompt = Fkeymap_prompt (keymap);
833 if (NILP (title) && !NILP (prompt))
834 title = prompt;
837 /* Extract the detailed info to make one pane. */
838 keymap_panes (maps, nmaps, NILP (position));
840 /* Make the title be the pane title of the first pane. */
841 if (!NILP (title) && menu_items_n_panes >= 0)
842 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
844 keymaps = 1;
846 else
848 /* We were given an old-fashioned menu. */
849 title = Fcar (menu);
850 CHECK_STRING (title);
852 list_of_panes (Fcdr (menu));
854 keymaps = 0;
857 if (NILP (position))
859 discard_menu_items ();
860 UNGCPRO;
861 return Qnil;
864 #ifdef HAVE_MENUS
865 /* Display them in a menu. */
866 record_unwind_protect (cleanup_popup_menu, Qnil);
867 BLOCK_INPUT;
869 selection = mac_menu_show (f, xpos, ypos, for_click,
870 keymaps, title, &error_name);
871 UNBLOCK_INPUT;
872 unbind_to (specpdl_count, Qnil);
874 UNGCPRO;
875 #endif /* HAVE_MENUS */
877 if (error_name) error (error_name);
878 return selection;
881 #ifdef HAVE_MENUS
883 /* Regard ESC and C-g as Cancel even without the Cancel button. */
885 #if 0 /* defined (MAC_OSX) */
886 static Boolean
887 mac_dialog_modal_filter (dialog, event, item_hit)
888 DialogRef dialog;
889 EventRecord *event;
890 DialogItemIndex *item_hit;
892 Boolean result;
894 result = StdFilterProc (dialog, event, item_hit);
895 if (result == false
896 && (event->what == keyDown || event->what == autoKey)
897 && ((event->message & charCodeMask) == kEscapeCharCode
898 || mac_quit_char_key_p (event->modifiers,
899 (event->message & keyCodeMask) >> 8)))
901 *item_hit = kStdCancelItemIndex;
902 return true;
905 return result;
907 #endif
909 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
910 doc: /* Pop up a dialog box and return user's selection.
911 POSITION specifies which frame to use.
912 This is normally a mouse button event or a window or frame.
913 If POSITION is t, it means to use the frame the mouse is on.
914 The dialog box appears in the middle of the specified frame.
916 CONTENTS specifies the alternatives to display in the dialog box.
917 It is a list of the form (DIALOG ITEM1 ITEM2...).
918 Each ITEM is a cons cell (STRING . VALUE).
919 The return value is VALUE from the chosen item.
921 An ITEM may also be just a string--that makes a nonselectable item.
922 An ITEM may also be nil--that means to put all preceding items
923 on the left of the dialog box and all following items on the right.
924 \(By default, approximately half appear on each side.)
926 If HEADER is non-nil, the frame title for the box is "Information",
927 otherwise it is "Question".
929 If the user gets rid of the dialog box without making a valid choice,
930 for instance using the window manager, then this produces a quit and
931 `x-popup-dialog' does not return. */)
932 (position, contents, header)
933 Lisp_Object position, contents, header;
935 FRAME_PTR f = NULL;
936 Lisp_Object window;
938 check_mac ();
940 /* Decode the first argument: find the window or frame to use. */
941 if (EQ (position, Qt)
942 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
943 || EQ (XCAR (position), Qtool_bar)
944 || EQ (XCAR (position), Qmac_apple_event))))
946 #if 0 /* Using the frame the mouse is on may not be right. */
947 /* Use the mouse's current position. */
948 FRAME_PTR new_f = SELECTED_FRAME ();
949 Lisp_Object bar_window;
950 enum scroll_bar_part part;
951 unsigned long time;
952 Lisp_Object x, y;
954 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
956 if (new_f != 0)
957 XSETFRAME (window, new_f);
958 else
959 window = selected_window;
960 #endif
961 window = selected_window;
963 else if (CONSP (position))
965 Lisp_Object tem;
966 tem = Fcar (position);
967 if (CONSP (tem))
968 window = Fcar (Fcdr (position));
969 else
971 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
972 window = Fcar (tem); /* POSN_WINDOW (tem) */
975 else if (WINDOWP (position) || FRAMEP (position))
976 window = position;
977 else
978 window = Qnil;
980 /* Decode where to put the menu. */
982 if (FRAMEP (window))
983 f = XFRAME (window);
984 else if (WINDOWP (window))
986 CHECK_LIVE_WINDOW (window);
987 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
989 else
990 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
991 but I don't want to make one now. */
992 CHECK_WINDOW (window);
994 #if 0 /* defined (MAC_OSX) */
995 /* Special treatment for Fmessage_box, Fyes_or_no_p, and Fy_or_n_p. */
996 if (EQ (position, Qt)
997 && STRINGP (Fcar (contents))
998 && ((!NILP (Fequal (XCDR (contents),
999 Fcons (Fcons (build_string ("OK"), Qt), Qnil)))
1000 && EQ (header, Qt))
1001 || (!NILP (Fequal (XCDR (contents),
1002 Fcons (Fcons (build_string ("Yes"), Qt),
1003 Fcons (Fcons (build_string ("No"), Qnil),
1004 Qnil))))
1005 && NILP (header))))
1007 OSStatus err = noErr;
1008 AlertStdCFStringAlertParamRec param;
1009 CFStringRef error_string, explanation_string;
1010 DialogRef alert;
1011 DialogItemIndex item_hit;
1012 Lisp_Object tem;
1014 /* Force a redisplay before showing the dialog. If a frame is
1015 created just before showing the dialog, its contents may not
1016 have been fully drawn. */
1017 Fredisplay (Qt);
1019 tem = Fstring_match (concat3 (build_string ("\\("),
1020 call0 (intern ("sentence-end")),
1021 build_string ("\\)\n")),
1022 XCAR (contents), Qnil);
1023 BLOCK_INPUT;
1024 if (NILP (tem))
1026 error_string = cfstring_create_with_string (XCAR (contents));
1027 if (error_string == NULL)
1028 err = memFullErr;
1029 explanation_string = NULL;
1031 else
1033 tem = Fmatch_end (make_number (1));
1034 error_string =
1035 cfstring_create_with_string (Fsubstring (XCAR (contents),
1036 make_number (0), tem));
1037 if (error_string == NULL)
1038 err = memFullErr;
1039 else
1041 XSETINT (tem, XINT (tem) + 1);
1042 explanation_string =
1043 cfstring_create_with_string (Fsubstring (XCAR (contents),
1044 tem, Qnil));
1045 if (explanation_string == NULL)
1047 CFRelease (error_string);
1048 err = memFullErr;
1052 if (err == noErr)
1053 err = GetStandardAlertDefaultParams (&param,
1054 kStdCFStringAlertVersionOne);
1055 if (err == noErr)
1057 param.movable = true;
1058 param.position = kWindowAlertPositionParentWindow;
1059 if (NILP (header))
1061 param.defaultText = CFSTR ("Yes");
1062 param.otherText = CFSTR ("No");
1063 #if 0
1064 param.cancelText = CFSTR ("Cancel");
1065 param.cancelButton = kAlertStdAlertCancelButton;
1066 #endif
1068 err = CreateStandardAlert (kAlertNoteAlert, error_string,
1069 explanation_string, &param, &alert);
1070 CFRelease (error_string);
1071 if (explanation_string)
1072 CFRelease (explanation_string);
1074 if (err == noErr)
1075 err = RunStandardAlert (alert, mac_dialog_modal_filter, &item_hit);
1076 UNBLOCK_INPUT;
1078 if (err == noErr)
1080 if (item_hit == kStdCancelItemIndex)
1081 Fsignal (Qquit, Qnil);
1082 else if (item_hit == kStdOkItemIndex)
1083 return Qt;
1084 else
1085 return Qnil;
1088 #endif
1089 #ifndef HAVE_DIALOGS
1090 /* Display a menu with these alternatives
1091 in the middle of frame F. */
1093 Lisp_Object x, y, frame, newpos;
1094 XSETFRAME (frame, f);
1095 XSETINT (x, x_pixel_width (f) / 2);
1096 XSETINT (y, x_pixel_height (f) / 2);
1097 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1099 return Fx_popup_menu (newpos,
1100 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1102 #else /* HAVE_DIALOGS */
1104 Lisp_Object title;
1105 char *error_name;
1106 Lisp_Object selection;
1107 int specpdl_count = SPECPDL_INDEX ();
1109 /* Decode the dialog items from what was specified. */
1110 title = Fcar (contents);
1111 CHECK_STRING (title);
1113 list_of_panes (Fcons (contents, Qnil));
1115 /* Display them in a dialog box. */
1116 record_unwind_protect (cleanup_popup_menu, Qnil);
1117 BLOCK_INPUT;
1118 selection = mac_dialog_show (f, 0, title, header, &error_name);
1119 UNBLOCK_INPUT;
1120 unbind_to (specpdl_count, Qnil);
1122 if (error_name) error (error_name);
1123 return selection;
1125 #endif /* HAVE_DIALOGS */
1128 /* Activate the menu bar of frame F.
1129 This is called from keyboard.c when it gets the
1130 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1132 To activate the menu bar, we use the button-press event location
1133 that was saved in saved_menu_event_location.
1135 But first we recompute the menu bar contents (the whole tree).
1137 The reason for saving the button event until here, instead of
1138 passing it to the toolkit right away, is that we can safely
1139 execute Lisp code. */
1141 void
1142 x_activate_menubar (f)
1143 FRAME_PTR f;
1145 SInt32 menu_choice;
1146 SInt16 menu_id, menu_item;
1147 extern Point saved_menu_event_location;
1149 set_frame_menubar (f, 0, 1);
1150 BLOCK_INPUT;
1152 popup_activated_flag = 1;
1153 menu_choice = MenuSelect (saved_menu_event_location);
1154 popup_activated_flag = 0;
1155 menu_id = HiWord (menu_choice);
1156 menu_item = LoWord (menu_choice);
1158 #if !TARGET_API_MAC_CARBON
1159 if (menu_id == min_menu_id[MAC_MENU_M_APPLE])
1160 do_apple_menu (menu_item);
1161 else
1162 #endif
1163 if (menu_id)
1165 MenuRef menu = GetMenuRef (menu_id);
1167 if (menu)
1169 UInt32 refcon;
1171 GetMenuItemRefCon (menu, menu_item, &refcon);
1172 find_and_call_menu_selection (f, f->menu_bar_items_used,
1173 f->menu_bar_vector, (void *) refcon);
1177 HiliteMenu (0);
1179 UNBLOCK_INPUT;
1182 /* Find the menu selection and store it in the keyboard buffer.
1183 F is the frame the menu is on.
1184 MENU_BAR_ITEMS_USED is the length of VECTOR.
1185 VECTOR is an array of menu events for the whole menu. */
1187 static void
1188 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
1189 FRAME_PTR f;
1190 int menu_bar_items_used;
1191 Lisp_Object vector;
1192 void *client_data;
1194 Lisp_Object prefix, entry;
1195 Lisp_Object *subprefix_stack;
1196 int submenu_depth = 0;
1197 int i;
1199 entry = Qnil;
1200 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
1201 prefix = Qnil;
1202 i = 0;
1204 while (i < menu_bar_items_used)
1206 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1208 subprefix_stack[submenu_depth++] = prefix;
1209 prefix = entry;
1210 i++;
1212 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1214 prefix = subprefix_stack[--submenu_depth];
1215 i++;
1217 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1219 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1220 i += MENU_ITEMS_PANE_LENGTH;
1222 else
1224 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1225 /* The EMACS_INT cast avoids a warning. There's no problem
1226 as long as pointers have enough bits to hold small integers. */
1227 if ((int) (EMACS_INT) client_data == i)
1229 int j;
1230 struct input_event buf;
1231 Lisp_Object frame;
1232 EVENT_INIT (buf);
1234 XSETFRAME (frame, f);
1235 buf.kind = MENU_BAR_EVENT;
1236 buf.frame_or_window = frame;
1237 buf.arg = frame;
1238 kbd_buffer_store_event (&buf);
1240 for (j = 0; j < submenu_depth; j++)
1241 if (!NILP (subprefix_stack[j]))
1243 buf.kind = MENU_BAR_EVENT;
1244 buf.frame_or_window = frame;
1245 buf.arg = subprefix_stack[j];
1246 kbd_buffer_store_event (&buf);
1249 if (!NILP (prefix))
1251 buf.kind = MENU_BAR_EVENT;
1252 buf.frame_or_window = frame;
1253 buf.arg = prefix;
1254 kbd_buffer_store_event (&buf);
1257 buf.kind = MENU_BAR_EVENT;
1258 buf.frame_or_window = frame;
1259 buf.arg = entry;
1260 kbd_buffer_store_event (&buf);
1262 return;
1264 i += MENU_ITEMS_ITEM_LENGTH;
1269 /* Allocate a widget_value, blocking input. */
1271 widget_value *
1272 xmalloc_widget_value ()
1274 widget_value *value;
1276 BLOCK_INPUT;
1277 value = malloc_widget_value ();
1278 UNBLOCK_INPUT;
1280 return value;
1283 /* This recursively calls free_widget_value on the tree of widgets.
1284 It must free all data that was malloc'ed for these widget_values.
1285 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1286 must be left alone. */
1288 void
1289 free_menubar_widget_value_tree (wv)
1290 widget_value *wv;
1292 if (! wv) return;
1294 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1296 if (wv->contents && (wv->contents != (widget_value*)1))
1298 free_menubar_widget_value_tree (wv->contents);
1299 wv->contents = (widget_value *) 0xDEADBEEF;
1301 if (wv->next)
1303 free_menubar_widget_value_tree (wv->next);
1304 wv->next = (widget_value *) 0xDEADBEEF;
1306 BLOCK_INPUT;
1307 free_widget_value (wv);
1308 UNBLOCK_INPUT;
1311 /* Set up data in menu_items for a menu bar item
1312 whose event type is ITEM_KEY (with string ITEM_NAME)
1313 and whose contents come from the list of keymaps MAPS. */
1315 static int
1316 parse_single_submenu (item_key, item_name, maps)
1317 Lisp_Object item_key, item_name, maps;
1319 Lisp_Object length;
1320 int len;
1321 Lisp_Object *mapvec;
1322 int i;
1323 int top_level_items = 0;
1325 length = Flength (maps);
1326 len = XINT (length);
1328 /* Convert the list MAPS into a vector MAPVEC. */
1329 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1330 for (i = 0; i < len; i++)
1332 mapvec[i] = Fcar (maps);
1333 maps = Fcdr (maps);
1336 /* Loop over the given keymaps, making a pane for each map.
1337 But don't make a pane that is empty--ignore that map instead. */
1338 for (i = 0; i < len; i++)
1340 if (!KEYMAPP (mapvec[i]))
1342 /* Here we have a command at top level in the menu bar
1343 as opposed to a submenu. */
1344 top_level_items = 1;
1345 push_menu_pane (Qnil, Qnil);
1346 push_menu_item (item_name, Qt, item_key, mapvec[i],
1347 Qnil, Qnil, Qnil, Qnil);
1349 else
1351 Lisp_Object prompt;
1352 prompt = Fkeymap_prompt (mapvec[i]);
1353 single_keymap_panes (mapvec[i],
1354 !NILP (prompt) ? prompt : item_name,
1355 item_key, 0, 10);
1359 return top_level_items;
1362 /* Create a tree of widget_value objects
1363 representing the panes and items
1364 in menu_items starting at index START, up to index END. */
1366 static widget_value *
1367 digest_single_submenu (start, end, top_level_items)
1368 int start, end, top_level_items;
1370 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1371 int i;
1372 int submenu_depth = 0;
1373 widget_value **submenu_stack;
1374 int panes_seen = 0;
1376 submenu_stack
1377 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1378 wv = xmalloc_widget_value ();
1379 wv->name = "menu";
1380 wv->value = 0;
1381 wv->enabled = 1;
1382 wv->button_type = BUTTON_TYPE_NONE;
1383 wv->help = Qnil;
1384 first_wv = wv;
1385 save_wv = 0;
1386 prev_wv = 0;
1388 /* Loop over all panes and items made by the preceding call
1389 to parse_single_submenu and construct a tree of widget_value objects.
1390 Ignore the panes and items used by previous calls to
1391 digest_single_submenu, even though those are also in menu_items. */
1392 i = start;
1393 while (i < end)
1395 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1397 submenu_stack[submenu_depth++] = save_wv;
1398 save_wv = prev_wv;
1399 prev_wv = 0;
1400 i++;
1402 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1404 prev_wv = save_wv;
1405 save_wv = submenu_stack[--submenu_depth];
1406 i++;
1408 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1409 && submenu_depth != 0)
1410 i += MENU_ITEMS_PANE_LENGTH;
1411 /* Ignore a nil in the item list.
1412 It's meaningful only for dialog boxes. */
1413 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1414 i += 1;
1415 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1417 /* Create a new pane. */
1418 Lisp_Object pane_name, prefix;
1419 char *pane_string;
1421 panes_seen++;
1423 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1424 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1426 #ifndef HAVE_MULTILINGUAL_MENU
1427 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1429 pane_name = ENCODE_MENU_STRING (pane_name);
1430 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1432 #endif
1433 pane_string = (NILP (pane_name)
1434 ? "" : (char *) SDATA (pane_name));
1435 /* If there is just one top-level pane, put all its items directly
1436 under the top-level menu. */
1437 if (menu_items_n_panes == 1)
1438 pane_string = "";
1440 /* If the pane has a meaningful name,
1441 make the pane a top-level menu item
1442 with its items as a submenu beneath it. */
1443 if (strcmp (pane_string, ""))
1445 wv = xmalloc_widget_value ();
1446 if (save_wv)
1447 save_wv->next = wv;
1448 else
1449 first_wv->contents = wv;
1450 wv->lname = pane_name;
1451 /* Set value to 1 so update_submenu_strings can handle '@' */
1452 wv->value = (char *)1;
1453 wv->enabled = 1;
1454 wv->button_type = BUTTON_TYPE_NONE;
1455 wv->help = Qnil;
1456 save_wv = wv;
1458 else
1459 save_wv = first_wv;
1461 prev_wv = 0;
1462 i += MENU_ITEMS_PANE_LENGTH;
1464 else
1466 /* Create a new item within current pane. */
1467 Lisp_Object item_name, enable, descrip, def, type, selected;
1468 Lisp_Object help;
1470 /* All items should be contained in panes. */
1471 if (panes_seen == 0)
1472 abort ();
1474 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1475 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1476 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1477 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1478 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1479 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1480 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1482 #ifndef HAVE_MULTILINGUAL_MENU
1483 if (STRING_MULTIBYTE (item_name))
1485 item_name = ENCODE_MENU_STRING (item_name);
1486 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1489 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1491 descrip = ENCODE_MENU_STRING (descrip);
1492 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1494 #endif /* not HAVE_MULTILINGUAL_MENU */
1496 wv = xmalloc_widget_value ();
1497 if (prev_wv)
1498 prev_wv->next = wv;
1499 else
1500 save_wv->contents = wv;
1502 wv->lname = item_name;
1503 if (!NILP (descrip))
1504 wv->lkey = descrip;
1505 wv->value = 0;
1506 /* The EMACS_INT cast avoids a warning. There's no problem
1507 as long as pointers have enough bits to hold small integers. */
1508 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1509 wv->enabled = !NILP (enable);
1511 if (NILP (type))
1512 wv->button_type = BUTTON_TYPE_NONE;
1513 else if (EQ (type, QCradio))
1514 wv->button_type = BUTTON_TYPE_RADIO;
1515 else if (EQ (type, QCtoggle))
1516 wv->button_type = BUTTON_TYPE_TOGGLE;
1517 else
1518 abort ();
1520 wv->selected = !NILP (selected);
1521 if (! STRINGP (help))
1522 help = Qnil;
1524 wv->help = help;
1526 prev_wv = wv;
1528 i += MENU_ITEMS_ITEM_LENGTH;
1532 /* If we have just one "menu item"
1533 that was originally a button, return it by itself. */
1534 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1536 wv = first_wv->contents;
1537 free_widget_value (first_wv);
1538 return wv;
1541 return first_wv;
1544 /* Walk through the widget_value tree starting at FIRST_WV and update
1545 the char * pointers from the corresponding lisp values.
1546 We do this after building the whole tree, since GC may happen while the
1547 tree is constructed, and small strings are relocated. So we must wait
1548 until no GC can happen before storing pointers into lisp values. */
1549 static void
1550 update_submenu_strings (first_wv)
1551 widget_value *first_wv;
1553 widget_value *wv;
1555 for (wv = first_wv; wv; wv = wv->next)
1557 if (STRINGP (wv->lname))
1559 wv->name = SDATA (wv->lname);
1561 /* Ignore the @ that means "separate pane".
1562 This is a kludge, but this isn't worth more time. */
1563 if (wv->value == (char *)1)
1565 if (wv->name[0] == '@')
1566 wv->name++;
1567 wv->value = 0;
1571 if (STRINGP (wv->lkey))
1572 wv->key = SDATA (wv->lkey);
1574 if (wv->contents)
1575 update_submenu_strings (wv->contents);
1580 #if TARGET_API_MAC_CARBON
1581 extern Lisp_Object Vshow_help_function;
1583 static Lisp_Object
1584 restore_show_help_function (old_show_help_function)
1585 Lisp_Object old_show_help_function;
1587 Vshow_help_function = old_show_help_function;
1589 return Qnil;
1592 static pascal OSStatus
1593 menu_target_item_handler (next_handler, event, data)
1594 EventHandlerCallRef next_handler;
1595 EventRef event;
1596 void *data;
1598 OSStatus err;
1599 MenuRef menu;
1600 MenuItemIndex menu_item;
1601 Lisp_Object help;
1602 GrafPtr port;
1603 int specpdl_count = SPECPDL_INDEX ();
1605 /* Don't be bothered with the overflowed toolbar items menu. */
1606 if (!popup_activated ())
1607 return eventNotHandledErr;
1609 err = GetEventParameter (event, kEventParamDirectObject, typeMenuRef,
1610 NULL, sizeof (MenuRef), NULL, &menu);
1611 if (err == noErr)
1612 err = GetEventParameter (event, kEventParamMenuItemIndex,
1613 typeMenuItemIndex, NULL,
1614 sizeof (MenuItemIndex), NULL, &menu_item);
1615 if (err == noErr)
1616 err = GetMenuItemProperty (menu, menu_item,
1617 MAC_EMACS_CREATOR_CODE, 'help',
1618 sizeof (Lisp_Object), NULL, &help);
1619 if (err != noErr)
1620 help = Qnil;
1622 /* Temporarily bind Vshow_help_function to Qnil because we don't
1623 want tooltips during menu tracking. */
1624 record_unwind_protect (restore_show_help_function, Vshow_help_function);
1625 Vshow_help_function = Qnil;
1626 GetPort (&port);
1627 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1628 SetPort (port);
1629 unbind_to (specpdl_count, Qnil);
1631 return err == noErr ? noErr : eventNotHandledErr;
1634 OSStatus
1635 install_menu_target_item_handler ()
1637 static const EventTypeSpec specs[] =
1638 {{kEventClassMenu, kEventMenuTargetItem}};
1640 return InstallApplicationEventHandler (NewEventHandlerUPP
1641 (menu_target_item_handler),
1642 GetEventTypeCount (specs),
1643 specs, NULL, NULL);
1645 #endif /* TARGET_API_MAC_CARBON */
1647 /* Event handler function that pops down a menu on C-g. We can only pop
1648 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1650 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1651 static pascal OSStatus
1652 menu_quit_handler (nextHandler, theEvent, userData)
1653 EventHandlerCallRef nextHandler;
1654 EventRef theEvent;
1655 void* userData;
1657 OSStatus err;
1658 UInt32 keyCode;
1659 UInt32 keyModifiers;
1661 err = GetEventParameter (theEvent, kEventParamKeyCode,
1662 typeUInt32, NULL, sizeof(UInt32), NULL, &keyCode);
1664 if (err == noErr)
1665 err = GetEventParameter (theEvent, kEventParamKeyModifiers,
1666 typeUInt32, NULL, sizeof(UInt32),
1667 NULL, &keyModifiers);
1669 if (err == noErr && mac_quit_char_key_p (keyModifiers, keyCode))
1671 MenuRef menu = userData != 0
1672 ? (MenuRef)userData : AcquireRootMenu ();
1674 CancelMenuTracking (menu, true, 0);
1675 if (!userData) ReleaseMenu (menu);
1676 return noErr;
1679 return CallNextEventHandler (nextHandler, theEvent);
1681 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1683 /* Add event handler to all menus that belong to KIND so we can detect
1684 C-g. ROOT_MENU is the root menu of the tracking session to dismiss
1685 when C-g is detected. NULL means the menu bar. If
1686 CancelMenuTracking isn't available, do nothing. */
1688 static void
1689 install_menu_quit_handler (kind, root_menu)
1690 enum mac_menu_kind kind;
1691 MenuRef root_menu;
1693 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1694 static const EventTypeSpec typesList[] =
1695 {{kEventClassKeyboard, kEventRawKeyDown}};
1696 int id;
1698 #if MAC_OS_X_VERSION_MIN_REQUIRED == 1020
1699 if (CancelMenuTracking == NULL)
1700 return;
1701 #endif
1702 for (id = min_menu_id[kind]; id < min_menu_id[kind + 1]; id++)
1704 MenuRef menu = GetMenuRef (id);
1706 if (menu == NULL)
1707 break;
1708 InstallMenuEventHandler (menu, menu_quit_handler,
1709 GetEventTypeCount (typesList),
1710 typesList, root_menu, NULL);
1712 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1715 /* Set the contents of the menubar widgets of frame F.
1716 The argument FIRST_TIME is currently ignored;
1717 it is set the first time this is called, from initialize_frame_menubar. */
1719 void
1720 set_frame_menubar (f, first_time, deep_p)
1721 FRAME_PTR f;
1722 int first_time;
1723 int deep_p;
1725 int menubar_widget = f->output_data.mac->menubar_widget;
1726 Lisp_Object items;
1727 widget_value *wv, *first_wv, *prev_wv = 0;
1728 int i, last_i = 0;
1729 int *submenu_start, *submenu_end;
1730 int *submenu_top_level_items, *submenu_n_panes;
1732 XSETFRAME (Vmenu_updating_frame, f);
1734 /* This seems to be unnecessary for Carbon. */
1735 #if 0
1736 if (! menubar_widget)
1737 deep_p = 1;
1738 else if (pending_menu_activation && !deep_p)
1739 deep_p = 1;
1740 #endif
1742 if (deep_p)
1744 /* Make a widget-value tree representing the entire menu trees. */
1746 struct buffer *prev = current_buffer;
1747 Lisp_Object buffer;
1748 int specpdl_count = SPECPDL_INDEX ();
1749 int previous_menu_items_used = f->menu_bar_items_used;
1750 Lisp_Object *previous_items
1751 = (Lisp_Object *) alloca (previous_menu_items_used
1752 * sizeof (Lisp_Object));
1754 /* If we are making a new widget, its contents are empty,
1755 do always reinitialize them. */
1756 if (! menubar_widget)
1757 previous_menu_items_used = 0;
1759 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1760 specbind (Qinhibit_quit, Qt);
1761 /* Don't let the debugger step into this code
1762 because it is not reentrant. */
1763 specbind (Qdebug_on_next_call, Qnil);
1765 record_unwind_save_match_data ();
1766 if (NILP (Voverriding_local_map_menu_flag))
1768 specbind (Qoverriding_terminal_local_map, Qnil);
1769 specbind (Qoverriding_local_map, Qnil);
1772 set_buffer_internal_1 (XBUFFER (buffer));
1774 /* Run the Lucid hook. */
1775 safe_run_hooks (Qactivate_menubar_hook);
1777 /* If it has changed current-menubar from previous value,
1778 really recompute the menubar from the value. */
1779 if (! NILP (Vlucid_menu_bar_dirty_flag))
1780 call0 (Qrecompute_lucid_menubar);
1781 safe_run_hooks (Qmenu_bar_update_hook);
1782 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1784 items = FRAME_MENU_BAR_ITEMS (f);
1786 /* Save the frame's previous menu bar contents data. */
1787 if (previous_menu_items_used)
1788 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1789 previous_menu_items_used * sizeof (Lisp_Object));
1791 /* Fill in menu_items with the current menu bar contents.
1792 This can evaluate Lisp code. */
1793 save_menu_items ();
1795 menu_items = f->menu_bar_vector;
1796 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1797 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1798 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1799 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1800 submenu_top_level_items
1801 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1802 init_menu_items ();
1803 for (i = 0; i < XVECTOR (items)->size; i += 4)
1805 Lisp_Object key, string, maps;
1807 last_i = i;
1809 key = XVECTOR (items)->contents[i];
1810 string = XVECTOR (items)->contents[i + 1];
1811 maps = XVECTOR (items)->contents[i + 2];
1812 if (NILP (string))
1813 break;
1815 submenu_start[i] = menu_items_used;
1817 menu_items_n_panes = 0;
1818 submenu_top_level_items[i]
1819 = parse_single_submenu (key, string, maps);
1820 submenu_n_panes[i] = menu_items_n_panes;
1822 submenu_end[i] = menu_items_used;
1825 finish_menu_items ();
1827 /* Convert menu_items into widget_value trees
1828 to display the menu. This cannot evaluate Lisp code. */
1830 wv = xmalloc_widget_value ();
1831 wv->name = "menubar";
1832 wv->value = 0;
1833 wv->enabled = 1;
1834 wv->button_type = BUTTON_TYPE_NONE;
1835 wv->help = Qnil;
1836 first_wv = wv;
1838 for (i = 0; i < last_i; i += 4)
1840 menu_items_n_panes = submenu_n_panes[i];
1841 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1842 submenu_top_level_items[i]);
1843 if (prev_wv)
1844 prev_wv->next = wv;
1845 else
1846 first_wv->contents = wv;
1847 /* Don't set wv->name here; GC during the loop might relocate it. */
1848 wv->enabled = 1;
1849 wv->button_type = BUTTON_TYPE_NONE;
1850 prev_wv = wv;
1853 set_buffer_internal_1 (prev);
1855 /* If there has been no change in the Lisp-level contents
1856 of the menu bar, skip redisplaying it. Just exit. */
1858 /* Compare the new menu items with the ones computed last time. */
1859 for (i = 0; i < previous_menu_items_used; i++)
1860 if (menu_items_used == i
1861 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1862 break;
1863 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1865 /* The menu items have not changed. Don't bother updating
1866 the menus in any form, since it would be a no-op. */
1867 free_menubar_widget_value_tree (first_wv);
1868 discard_menu_items ();
1869 unbind_to (specpdl_count, Qnil);
1870 return;
1873 /* The menu items are different, so store them in the frame. */
1874 f->menu_bar_vector = menu_items;
1875 f->menu_bar_items_used = menu_items_used;
1877 /* This calls restore_menu_items to restore menu_items, etc.,
1878 as they were outside. */
1879 unbind_to (specpdl_count, Qnil);
1881 /* Now GC cannot happen during the lifetime of the widget_value,
1882 so it's safe to store data from a Lisp_String. */
1883 wv = first_wv->contents;
1884 for (i = 0; i < XVECTOR (items)->size; i += 4)
1886 Lisp_Object string;
1887 string = XVECTOR (items)->contents[i + 1];
1888 if (NILP (string))
1889 break;
1890 wv->name = (char *) SDATA (string);
1891 update_submenu_strings (wv->contents);
1892 wv = wv->next;
1896 else
1898 /* Make a widget-value tree containing
1899 just the top level menu bar strings. */
1901 wv = xmalloc_widget_value ();
1902 wv->name = "menubar";
1903 wv->value = 0;
1904 wv->enabled = 1;
1905 wv->button_type = BUTTON_TYPE_NONE;
1906 wv->help = Qnil;
1907 first_wv = wv;
1909 items = FRAME_MENU_BAR_ITEMS (f);
1910 for (i = 0; i < XVECTOR (items)->size; i += 4)
1912 Lisp_Object string;
1914 string = XVECTOR (items)->contents[i + 1];
1915 if (NILP (string))
1916 break;
1918 wv = xmalloc_widget_value ();
1919 wv->name = (char *) SDATA (string);
1920 wv->value = 0;
1921 wv->enabled = 1;
1922 wv->button_type = BUTTON_TYPE_NONE;
1923 wv->help = Qnil;
1924 /* This prevents lwlib from assuming this
1925 menu item is really supposed to be empty. */
1926 /* The EMACS_INT cast avoids a warning.
1927 This value just has to be different from small integers. */
1928 wv->call_data = (void *) (EMACS_INT) (-1);
1930 if (prev_wv)
1931 prev_wv->next = wv;
1932 else
1933 first_wv->contents = wv;
1934 prev_wv = wv;
1937 /* Forget what we thought we knew about what is in the
1938 detailed contents of the menu bar menus.
1939 Changing the top level always destroys the contents. */
1940 f->menu_bar_items_used = 0;
1943 /* Create or update the menu bar widget. */
1945 BLOCK_INPUT;
1947 /* Non-null value to indicate menubar has already been "created". */
1948 f->output_data.mac->menubar_widget = 1;
1950 fill_menubar (first_wv->contents, deep_p);
1952 /* Add event handler so we can detect C-g. */
1953 install_menu_quit_handler (MAC_MENU_MENU_BAR, NULL);
1954 install_menu_quit_handler (MAC_MENU_MENU_BAR_SUB, NULL);
1955 free_menubar_widget_value_tree (first_wv);
1957 UNBLOCK_INPUT;
1960 /* Get rid of the menu bar of frame F, and free its storage.
1961 This is used when deleting a frame, and when turning off the menu bar. */
1963 void
1964 free_frame_menubar (f)
1965 FRAME_PTR f;
1967 f->output_data.mac->menubar_widget = 0;
1971 static Lisp_Object
1972 pop_down_menu (arg)
1973 Lisp_Object arg;
1975 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
1976 FRAME_PTR f = p->pointer;
1977 MenuRef menu = GetMenuRef (min_menu_id[MAC_MENU_POPUP]);
1979 BLOCK_INPUT;
1981 /* Must reset this manually because the button release event is not
1982 passed to Emacs event loop. */
1983 FRAME_MAC_DISPLAY_INFO (f)->grabbed = 0;
1985 /* delete all menus */
1986 dispose_menus (MAC_MENU_POPUP_SUB, 0);
1987 DeleteMenu (min_menu_id[MAC_MENU_POPUP]);
1988 DisposeMenu (menu);
1990 UNBLOCK_INPUT;
1992 return Qnil;
1995 /* Mac_menu_show actually displays a menu using the panes and items in
1996 menu_items and returns the value selected from it; we assume input
1997 is blocked by the caller. */
1999 /* F is the frame the menu is for.
2000 X and Y are the frame-relative specified position,
2001 relative to the inside upper left corner of the frame F.
2002 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2003 KEYMAPS is 1 if this menu was specified with keymaps;
2004 in that case, we return a list containing the chosen item's value
2005 and perhaps also the pane's prefix.
2006 TITLE is the specified menu title.
2007 ERROR is a place to store an error message string in case of failure.
2008 (We return nil on failure, but the value doesn't actually matter.) */
2010 static Lisp_Object
2011 mac_menu_show (f, x, y, for_click, keymaps, title, error)
2012 FRAME_PTR f;
2013 int x;
2014 int y;
2015 int for_click;
2016 int keymaps;
2017 Lisp_Object title;
2018 char **error;
2020 int i;
2021 int menu_item_choice;
2022 UInt32 menu_item_selection;
2023 MenuRef menu;
2024 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2025 widget_value **submenu_stack
2026 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
2027 Lisp_Object *subprefix_stack
2028 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
2029 int submenu_depth = 0;
2031 int first_pane;
2032 int specpdl_count = SPECPDL_INDEX ();
2034 *error = NULL;
2036 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2038 *error = "Empty menu";
2039 return Qnil;
2042 /* Create a tree of widget_value objects
2043 representing the panes and their items. */
2044 wv = xmalloc_widget_value ();
2045 wv->name = "menu";
2046 wv->value = 0;
2047 wv->enabled = 1;
2048 wv->button_type = BUTTON_TYPE_NONE;
2049 wv->help = Qnil;
2050 first_wv = wv;
2051 first_pane = 1;
2053 /* Loop over all panes and items, filling in the tree. */
2054 i = 0;
2055 while (i < menu_items_used)
2057 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2059 submenu_stack[submenu_depth++] = save_wv;
2060 save_wv = prev_wv;
2061 prev_wv = 0;
2062 first_pane = 1;
2063 i++;
2065 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2067 prev_wv = save_wv;
2068 save_wv = submenu_stack[--submenu_depth];
2069 first_pane = 0;
2070 i++;
2072 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2073 && submenu_depth != 0)
2074 i += MENU_ITEMS_PANE_LENGTH;
2075 /* Ignore a nil in the item list.
2076 It's meaningful only for dialog boxes. */
2077 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2078 i += 1;
2079 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2081 /* Create a new pane. */
2082 Lisp_Object pane_name, prefix;
2083 char *pane_string;
2085 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2086 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2088 #ifndef HAVE_MULTILINGUAL_MENU
2089 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2091 pane_name = ENCODE_MENU_STRING (pane_name);
2092 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2094 #endif
2095 pane_string = (NILP (pane_name)
2096 ? "" : (char *) SDATA (pane_name));
2097 /* If there is just one top-level pane, put all its items directly
2098 under the top-level menu. */
2099 if (menu_items_n_panes == 1)
2100 pane_string = "";
2102 /* If the pane has a meaningful name,
2103 make the pane a top-level menu item
2104 with its items as a submenu beneath it. */
2105 if (!keymaps && strcmp (pane_string, ""))
2107 wv = xmalloc_widget_value ();
2108 if (save_wv)
2109 save_wv->next = wv;
2110 else
2111 first_wv->contents = wv;
2112 wv->name = pane_string;
2113 if (keymaps && !NILP (prefix))
2114 wv->name++;
2115 wv->value = 0;
2116 wv->enabled = 1;
2117 wv->button_type = BUTTON_TYPE_NONE;
2118 wv->help = Qnil;
2119 save_wv = wv;
2120 prev_wv = 0;
2122 else if (first_pane)
2124 save_wv = wv;
2125 prev_wv = 0;
2127 first_pane = 0;
2128 i += MENU_ITEMS_PANE_LENGTH;
2130 else
2132 /* Create a new item within current pane. */
2133 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2134 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2135 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2136 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2137 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2138 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2139 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2140 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2142 #ifndef HAVE_MULTILINGUAL_MENU
2143 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2145 item_name = ENCODE_MENU_STRING (item_name);
2146 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2149 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2151 descrip = ENCODE_MENU_STRING (descrip);
2152 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2154 #endif /* not HAVE_MULTILINGUAL_MENU */
2156 wv = xmalloc_widget_value ();
2157 if (prev_wv)
2158 prev_wv->next = wv;
2159 else
2160 save_wv->contents = wv;
2161 wv->name = (char *) SDATA (item_name);
2162 if (!NILP (descrip))
2163 wv->key = (char *) SDATA (descrip);
2164 wv->value = 0;
2165 /* Use the contents index as call_data, since we are
2166 restricted to 16-bits. */
2167 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
2168 wv->enabled = !NILP (enable);
2170 if (NILP (type))
2171 wv->button_type = BUTTON_TYPE_NONE;
2172 else if (EQ (type, QCtoggle))
2173 wv->button_type = BUTTON_TYPE_TOGGLE;
2174 else if (EQ (type, QCradio))
2175 wv->button_type = BUTTON_TYPE_RADIO;
2176 else
2177 abort ();
2179 wv->selected = !NILP (selected);
2181 if (! STRINGP (help))
2182 help = Qnil;
2184 wv->help = help;
2186 prev_wv = wv;
2188 i += MENU_ITEMS_ITEM_LENGTH;
2192 /* Deal with the title, if it is non-nil. */
2193 if (!NILP (title))
2195 widget_value *wv_title = xmalloc_widget_value ();
2196 widget_value *wv_sep = xmalloc_widget_value ();
2198 /* Maybe replace this separator with a bitmap or owner-draw item
2199 so that it looks better. Having two separators looks odd. */
2200 wv_sep->name = "--";
2201 wv_sep->next = first_wv->contents;
2202 wv_sep->help = Qnil;
2204 #ifndef HAVE_MULTILINGUAL_MENU
2205 if (STRING_MULTIBYTE (title))
2206 title = ENCODE_MENU_STRING (title);
2207 #endif
2209 wv_title->name = (char *) SDATA (title);
2210 wv_title->enabled = FALSE;
2211 wv_title->title = TRUE;
2212 wv_title->button_type = BUTTON_TYPE_NONE;
2213 wv_title->help = Qnil;
2214 wv_title->next = wv_sep;
2215 first_wv->contents = wv_title;
2218 /* Actually create the menu. */
2219 menu = NewMenu (min_menu_id[MAC_MENU_POPUP], "\p");
2220 InsertMenu (menu, -1);
2221 fill_menu (menu, first_wv->contents, MAC_MENU_POPUP_SUB,
2222 min_menu_id[MAC_MENU_POPUP_SUB]);
2224 /* Free the widget_value objects we used to specify the
2225 contents. */
2226 free_menubar_widget_value_tree (first_wv);
2228 /* Adjust coordinates to be root-window-relative. */
2229 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2230 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2232 /* No selection has been chosen yet. */
2233 menu_item_selection = 0;
2235 record_unwind_protect (pop_down_menu, make_save_value (f, 0));
2237 /* Add event handler so we can detect C-g. */
2238 install_menu_quit_handler (MAC_MENU_POPUP, menu);
2239 install_menu_quit_handler (MAC_MENU_POPUP_SUB, menu);
2241 /* Display the menu. */
2242 popup_activated_flag = 1;
2243 menu_item_choice = PopUpMenuSelect (menu, y, x, 0);
2244 popup_activated_flag = 0;
2246 /* Get the refcon to find the correct item */
2247 if (menu_item_choice)
2249 MenuRef sel_menu = GetMenuRef (HiWord (menu_item_choice));
2251 if (sel_menu)
2252 GetMenuItemRefCon (sel_menu, LoWord (menu_item_choice),
2253 &menu_item_selection);
2256 unbind_to (specpdl_count, Qnil);
2258 /* Find the selected item, and its pane, to return
2259 the proper value. */
2260 if (menu_item_selection != 0)
2262 Lisp_Object prefix, entry;
2264 prefix = entry = Qnil;
2265 i = 0;
2266 while (i < menu_items_used)
2268 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2270 subprefix_stack[submenu_depth++] = prefix;
2271 prefix = entry;
2272 i++;
2274 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2276 prefix = subprefix_stack[--submenu_depth];
2277 i++;
2279 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2281 prefix
2282 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2283 i += MENU_ITEMS_PANE_LENGTH;
2285 /* Ignore a nil in the item list.
2286 It's meaningful only for dialog boxes. */
2287 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2288 i += 1;
2289 else
2291 entry
2292 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2293 if (menu_item_selection == i)
2295 if (keymaps != 0)
2297 int j;
2299 entry = Fcons (entry, Qnil);
2300 if (!NILP (prefix))
2301 entry = Fcons (prefix, entry);
2302 for (j = submenu_depth - 1; j >= 0; j--)
2303 if (!NILP (subprefix_stack[j]))
2304 entry = Fcons (subprefix_stack[j], entry);
2306 return entry;
2308 i += MENU_ITEMS_ITEM_LENGTH;
2312 else if (!for_click)
2313 /* Make "Cancel" equivalent to C-g. */
2314 Fsignal (Qquit, Qnil);
2316 return Qnil;
2320 #ifdef HAVE_DIALOGS
2321 /* Construct native Mac OS dialog based on widget_value tree. */
2323 #if TARGET_API_MAC_CARBON
2325 #define DIALOG_BUTTON_COMMAND_ID_OFFSET 'Bt\0\0'
2326 #define DIALOG_BUTTON_COMMAND_ID_P(id) \
2327 (((id) & ~0xffff) == DIALOG_BUTTON_COMMAND_ID_OFFSET)
2328 #define DIALOG_BUTTON_COMMAND_ID_VALUE(id) \
2329 ((id) - DIALOG_BUTTON_COMMAND_ID_OFFSET)
2330 #define DIALOG_BUTTON_MAKE_COMMAND_ID(value) \
2331 ((value) + DIALOG_BUTTON_COMMAND_ID_OFFSET)
2333 extern EMACS_TIME timer_check P_ ((int));
2335 static pascal OSStatus
2336 mac_handle_dialog_event (next_handler, event, data)
2337 EventHandlerCallRef next_handler;
2338 EventRef event;
2339 void *data;
2341 OSStatus err, result = eventNotHandledErr;
2342 WindowRef window = (WindowRef) data;
2343 int quit_event_loop_p = 0;
2345 switch (GetEventClass (event))
2347 case kEventClassCommand:
2349 HICommand command;
2351 err = GetEventParameter (event, kEventParamDirectObject,
2352 typeHICommand, NULL, sizeof (HICommand),
2353 NULL, &command);
2354 if (err == noErr)
2355 if (DIALOG_BUTTON_COMMAND_ID_P (command.commandID))
2357 SetWRefCon (window, command.commandID);
2358 quit_event_loop_p = 1;
2359 break;
2362 result = CallNextEventHandler (next_handler, event);
2364 break;
2366 case kEventClassKeyboard:
2368 OSStatus result;
2369 char char_code;
2371 result = CallNextEventHandler (next_handler, event);
2372 if (result != eventNotHandledErr)
2373 break;
2375 err = GetEventParameter (event, kEventParamKeyMacCharCodes,
2376 typeChar, NULL, sizeof (char),
2377 NULL, &char_code);
2378 if (err == noErr)
2379 switch (char_code)
2381 case kEscapeCharCode:
2382 quit_event_loop_p = 1;
2383 break;
2385 default:
2387 UInt32 modifiers, key_code;
2389 err = GetEventParameter (event, kEventParamKeyModifiers,
2390 typeUInt32, NULL, sizeof (UInt32),
2391 NULL, &modifiers);
2392 if (err == noErr)
2393 err = GetEventParameter (event, kEventParamKeyCode,
2394 typeUInt32, NULL, sizeof (UInt32),
2395 NULL, &key_code);
2396 if (err == noErr)
2397 if (mac_quit_char_key_p (modifiers, key_code))
2398 quit_event_loop_p = 1;
2400 break;
2403 break;
2405 default:
2406 abort ();
2409 if (quit_event_loop_p)
2411 err = QuitEventLoop (GetCurrentEventLoop ());
2412 if (err == noErr)
2413 result = noErr;
2416 return result;
2419 static OSStatus
2420 install_dialog_event_handler (window)
2421 WindowRef window;
2423 static const EventTypeSpec specs[] =
2424 {{kEventClassCommand, kEventCommandProcess},
2425 {kEventClassKeyboard, kEventRawKeyDown}};
2426 static EventHandlerUPP handle_dialog_eventUPP = NULL;
2428 if (handle_dialog_eventUPP == NULL)
2429 handle_dialog_eventUPP = NewEventHandlerUPP (mac_handle_dialog_event);
2430 return InstallWindowEventHandler (window, handle_dialog_eventUPP,
2431 GetEventTypeCount (specs), specs,
2432 window, NULL);
2435 #define DIALOG_LEFT_MARGIN (112)
2436 #define DIALOG_TOP_MARGIN (24)
2437 #define DIALOG_RIGHT_MARGIN (24)
2438 #define DIALOG_BOTTOM_MARGIN (20)
2439 #define DIALOG_MIN_INNER_WIDTH (338)
2440 #define DIALOG_MAX_INNER_WIDTH (564)
2441 #define DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE (12)
2442 #define DIALOG_BUTTON_BUTTON_VERTICAL_SPACE (12)
2443 #define DIALOG_BUTTON_MIN_WIDTH (68)
2444 #define DIALOG_TEXT_MIN_HEIGHT (50)
2445 #define DIALOG_TEXT_BUTTONS_VERTICAL_SPACE (10)
2446 #define DIALOG_ICON_WIDTH (64)
2447 #define DIALOG_ICON_HEIGHT (64)
2448 #define DIALOG_ICON_LEFT_MARGIN (24)
2449 #define DIALOG_ICON_TOP_MARGIN (15)
2451 static Lisp_Object
2452 pop_down_dialog (arg)
2453 Lisp_Object arg;
2455 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
2456 WindowRef window = p->pointer;
2458 BLOCK_INPUT;
2460 if (popup_activated_flag)
2461 EndAppModalStateForWindow (window);
2462 DisposeWindow (window);
2463 popup_activated_flag = 0;
2465 UNBLOCK_INPUT;
2467 return Qnil;
2470 static int
2471 create_and_show_dialog (f, first_wv)
2472 FRAME_PTR f;
2473 widget_value *first_wv;
2475 OSStatus err;
2476 char *dialog_name, *message;
2477 int nb_buttons, first_group_count, i, result = 0;
2478 widget_value *wv;
2479 short buttons_height, text_height, inner_width, inner_height;
2480 Rect empty_rect, *rects;
2481 WindowRef window = NULL;
2482 ControlRef *buttons, default_button = NULL, text;
2483 int specpdl_count = SPECPDL_INDEX ();
2485 dialog_name = first_wv->name;
2486 nb_buttons = dialog_name[1] - '0';
2487 first_group_count = nb_buttons - (dialog_name[4] - '0');
2489 wv = first_wv->contents;
2490 message = wv->value;
2492 wv = wv->next;
2493 SetRect (&empty_rect, 0, 0, 0, 0);
2495 /* Create dialog window. */
2496 err = CreateNewWindow (kMovableModalWindowClass,
2497 kWindowStandardHandlerAttribute,
2498 &empty_rect, &window);
2499 if (err == noErr)
2501 record_unwind_protect (pop_down_dialog, make_save_value (window, 0));
2502 err = SetThemeWindowBackground (window, kThemeBrushMovableModalBackground,
2503 true);
2505 if (err == noErr)
2506 err = SetWindowTitleWithCFString (window, (dialog_name[0] == 'Q'
2507 ? CFSTR ("Question")
2508 : CFSTR ("Information")));
2510 /* Create button controls and measure their optimal bounds. */
2511 if (err == noErr)
2513 buttons = alloca (sizeof (ControlRef) * nb_buttons);
2514 rects = alloca (sizeof (Rect) * nb_buttons);
2515 for (i = 0; i < nb_buttons; i++)
2517 CFStringRef label = cfstring_create_with_utf8_cstring (wv->value);
2519 if (label == NULL)
2520 err = memFullErr;
2521 else
2523 err = CreatePushButtonControl (window, &empty_rect,
2524 label, &buttons[i]);
2525 CFRelease (label);
2527 if (err == noErr)
2529 if (!wv->enabled)
2531 #ifdef MAC_OSX
2532 err = DisableControl (buttons[i]);
2533 #else
2534 err = DeactivateControl (buttons[i]);
2535 #endif
2537 else if (default_button == NULL)
2538 default_button = buttons[i];
2540 if (err == noErr)
2542 SInt16 unused;
2544 rects[i] = empty_rect;
2545 err = GetBestControlRect (buttons[i], &rects[i], &unused);
2547 if (err == noErr)
2549 UInt32 command_id;
2551 OffsetRect (&rects[i], -rects[i].left, -rects[i].top);
2552 if (rects[i].right < DIALOG_BUTTON_MIN_WIDTH)
2553 rects[i].right = DIALOG_BUTTON_MIN_WIDTH;
2554 else if (rects[i].right > DIALOG_MAX_INNER_WIDTH)
2555 rects[i].right = DIALOG_MAX_INNER_WIDTH;
2557 command_id = DIALOG_BUTTON_MAKE_COMMAND_ID ((int) wv->call_data);
2558 err = SetControlCommandID (buttons[i], command_id);
2560 if (err != noErr)
2561 break;
2562 wv = wv->next;
2566 /* Layout buttons. rects[i] is set relative to the bottom-right
2567 corner of the inner box. */
2568 if (err == noErr)
2570 short bottom, right, max_height, left_align_shift;
2572 inner_width = DIALOG_MIN_INNER_WIDTH;
2573 bottom = right = max_height = 0;
2574 for (i = 0; i < nb_buttons; i++)
2576 if (right - rects[i].right < - inner_width)
2578 if (i != first_group_count
2579 && right - rects[i].right >= - DIALOG_MAX_INNER_WIDTH)
2580 inner_width = - (right - rects[i].right);
2581 else
2583 bottom -= max_height + DIALOG_BUTTON_BUTTON_VERTICAL_SPACE;
2584 right = max_height = 0;
2587 if (max_height < rects[i].bottom)
2588 max_height = rects[i].bottom;
2589 OffsetRect (&rects[i], right - rects[i].right,
2590 bottom - rects[i].bottom);
2591 right = rects[i].left - DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE;
2592 if (i == first_group_count - 1)
2593 right -= DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE;
2595 buttons_height = - (bottom - max_height);
2597 left_align_shift = - (inner_width + rects[nb_buttons - 1].left);
2598 for (i = nb_buttons - 1; i >= first_group_count; i--)
2600 if (bottom != rects[i].bottom)
2602 left_align_shift = - (inner_width + rects[i].left);
2603 bottom = rects[i].bottom;
2605 OffsetRect (&rects[i], left_align_shift, 0);
2609 /* Create a static text control and measure its bounds. */
2610 if (err == noErr)
2612 CFStringRef message_string;
2613 Rect bounds;
2615 message_string = cfstring_create_with_utf8_cstring (message);
2616 if (message_string == NULL)
2617 err = memFullErr;
2618 else
2620 ControlFontStyleRec text_style;
2622 text_style.flags = 0;
2623 SetRect (&bounds, 0, 0, inner_width, 0);
2624 err = CreateStaticTextControl (window, &bounds, message_string,
2625 &text_style, &text);
2626 CFRelease (message_string);
2628 if (err == noErr)
2630 SInt16 unused;
2632 bounds = empty_rect;
2633 err = GetBestControlRect (text, &bounds, &unused);
2635 if (err == noErr)
2637 text_height = bounds.bottom - bounds.top;
2638 if (text_height < DIALOG_TEXT_MIN_HEIGHT)
2639 text_height = DIALOG_TEXT_MIN_HEIGHT;
2643 /* Place buttons. */
2644 if (err == noErr)
2646 inner_height = (text_height + DIALOG_TEXT_BUTTONS_VERTICAL_SPACE
2647 + buttons_height);
2649 for (i = 0; i < nb_buttons; i++)
2651 OffsetRect (&rects[i], DIALOG_LEFT_MARGIN + inner_width,
2652 DIALOG_TOP_MARGIN + inner_height);
2653 SetControlBounds (buttons[i], &rects[i]);
2657 /* Place text. */
2658 if (err == noErr)
2660 Rect bounds;
2662 SetRect (&bounds, DIALOG_LEFT_MARGIN, DIALOG_TOP_MARGIN,
2663 DIALOG_LEFT_MARGIN + inner_width,
2664 DIALOG_TOP_MARGIN + text_height);
2665 SetControlBounds (text, &bounds);
2668 /* Create the application icon at the upper-left corner. */
2669 if (err == noErr)
2671 ControlButtonContentInfo content;
2672 ControlRef icon;
2673 static const ProcessSerialNumber psn = {0, kCurrentProcess};
2674 #ifdef MAC_OSX
2675 FSRef app_location;
2676 #else
2677 ProcessInfoRec pinfo;
2678 FSSpec app_spec;
2679 #endif
2680 SInt16 unused;
2682 content.contentType = kControlContentIconRef;
2683 #ifdef MAC_OSX
2684 err = GetProcessBundleLocation (&psn, &app_location);
2685 if (err == noErr)
2686 err = GetIconRefFromFileInfo (&app_location, 0, NULL, 0, NULL,
2687 kIconServicesNormalUsageFlag,
2688 &content.u.iconRef, &unused);
2689 #else
2690 bzero (&pinfo, sizeof (ProcessInfoRec));
2691 pinfo.processInfoLength = sizeof (ProcessInfoRec);
2692 pinfo.processAppSpec = &app_spec;
2693 err = GetProcessInformation (&psn, &pinfo);
2694 if (err == noErr)
2695 err = GetIconRefFromFile (&app_spec, &content.u.iconRef, &unused);
2696 #endif
2697 if (err == noErr)
2699 Rect bounds;
2701 SetRect (&bounds, DIALOG_ICON_LEFT_MARGIN, DIALOG_ICON_TOP_MARGIN,
2702 DIALOG_ICON_LEFT_MARGIN + DIALOG_ICON_WIDTH,
2703 DIALOG_ICON_TOP_MARGIN + DIALOG_ICON_HEIGHT);
2704 err = CreateIconControl (window, &bounds, &content, true, &icon);
2705 ReleaseIconRef (content.u.iconRef);
2709 /* Show the dialog window and run event loop. */
2710 if (err == noErr)
2711 if (default_button)
2712 err = SetWindowDefaultButton (window, default_button);
2713 if (err == noErr)
2714 err = install_dialog_event_handler (window);
2715 if (err == noErr)
2717 SizeWindow (window,
2718 DIALOG_LEFT_MARGIN + inner_width + DIALOG_RIGHT_MARGIN,
2719 DIALOG_TOP_MARGIN + inner_height + DIALOG_BOTTOM_MARGIN,
2720 true);
2721 err = RepositionWindow (window, FRAME_MAC_WINDOW (f),
2722 kWindowAlertPositionOnParentWindow);
2724 if (err == noErr)
2726 SetWRefCon (window, 0);
2727 ShowWindow (window);
2728 BringToFront (window);
2729 popup_activated_flag = 1;
2730 err = BeginAppModalStateForWindow (window);
2732 if (err == noErr)
2734 EventTargetRef toolbox_dispatcher = GetEventDispatcherTarget ();
2736 while (1)
2738 EMACS_TIME next_time = timer_check (1);
2739 long secs = EMACS_SECS (next_time);
2740 long usecs = EMACS_USECS (next_time);
2741 EventTimeout timeout;
2742 EventRef event;
2744 if (secs < 0 || (secs == 0 && usecs == 0))
2746 /* Sometimes timer_check returns -1 (no timers) even if
2747 there are timers. So do a timeout anyway. */
2748 secs = 1;
2749 usecs = 0;
2752 timeout = (secs * kEventDurationSecond
2753 + usecs * kEventDurationMicrosecond);
2754 err = ReceiveNextEvent (0, NULL, timeout, kEventRemoveFromQueue,
2755 &event);
2756 if (err == noErr)
2758 SendEventToEventTarget (event, toolbox_dispatcher);
2759 ReleaseEvent (event);
2761 else if (err != eventLoopTimedOutErr)
2763 if (err == eventLoopQuitErr)
2764 err = noErr;
2765 break;
2769 if (err == noErr)
2771 UInt32 command_id = GetWRefCon (window);
2773 if (DIALOG_BUTTON_COMMAND_ID_P (command_id))
2774 result = DIALOG_BUTTON_COMMAND_ID_VALUE (command_id);
2777 unbind_to (specpdl_count, Qnil);
2779 return result;
2781 #else /* not TARGET_API_MAC_CARBON */
2782 static int
2783 mac_dialog (widget_value *wv)
2785 char *dialog_name;
2786 char *prompt;
2787 char **button_labels;
2788 UInt32 *ref_cons;
2789 int nb_buttons;
2790 int left_count;
2791 int i;
2792 int dialog_width;
2793 Rect rect;
2794 WindowRef window_ptr;
2795 ControlRef ch;
2796 int left;
2797 EventRecord event_record;
2798 SInt16 part_code;
2799 int control_part_code;
2800 Point mouse;
2802 dialog_name = wv->name;
2803 nb_buttons = dialog_name[1] - '0';
2804 left_count = nb_buttons - (dialog_name[4] - '0');
2805 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
2806 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
2808 wv = wv->contents;
2809 prompt = (char *) alloca (strlen (wv->value) + 1);
2810 strcpy (prompt, wv->value);
2811 c2pstr (prompt);
2813 wv = wv->next;
2814 for (i = 0; i < nb_buttons; i++)
2816 button_labels[i] = wv->value;
2817 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
2818 strcpy (button_labels[i], wv->value);
2819 c2pstr (button_labels[i]);
2820 ref_cons[i] = (UInt32) wv->call_data;
2821 wv = wv->next;
2824 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowRef) -1);
2826 SetPortWindowPort (window_ptr);
2828 TextFont (0);
2829 /* Left and right margins in the dialog are 13 pixels each.*/
2830 dialog_width = 14;
2831 /* Calculate width of dialog box: 8 pixels on each side of the text
2832 label in each button, 12 pixels between buttons. */
2833 for (i = 0; i < nb_buttons; i++)
2834 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
2836 if (left_count != 0 && nb_buttons - left_count != 0)
2837 dialog_width += 12;
2839 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
2841 SizeWindow (window_ptr, dialog_width, 78, 0);
2842 ShowWindow (window_ptr);
2844 SetPortWindowPort (window_ptr);
2846 TextFont (0);
2848 MoveTo (13, 29);
2849 DrawString (prompt);
2851 left = 13;
2852 for (i = 0; i < nb_buttons; i++)
2854 int button_width = StringWidth (button_labels[i]) + 16;
2855 SetRect (&rect, left, 45, left + button_width, 65);
2856 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2857 kControlPushButtonProc, ref_cons[i]);
2858 left += button_width + 12;
2859 if (i == left_count - 1)
2860 left += 12;
2863 i = 0;
2864 while (!i)
2866 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2867 if (event_record.what == mouseDown)
2869 part_code = FindWindow (event_record.where, &window_ptr);
2870 if (part_code == inContent)
2872 mouse = event_record.where;
2873 GlobalToLocal (&mouse);
2874 control_part_code = FindControl (mouse, window_ptr, &ch);
2875 if (control_part_code == kControlButtonPart)
2876 if (TrackControl (ch, mouse, NULL))
2877 i = GetControlReference (ch);
2882 DisposeWindow (window_ptr);
2884 return i;
2886 #endif /* not TARGET_API_MAC_CARBON */
2888 static char * button_names [] = {
2889 "button1", "button2", "button3", "button4", "button5",
2890 "button6", "button7", "button8", "button9", "button10" };
2892 static Lisp_Object
2893 mac_dialog_show (f, keymaps, title, header, error_name)
2894 FRAME_PTR f;
2895 int keymaps;
2896 Lisp_Object title, header;
2897 char **error_name;
2899 int i, nb_buttons=0;
2900 char dialog_name[6];
2901 int menu_item_selection;
2903 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2905 /* Number of elements seen so far, before boundary. */
2906 int left_count = 0;
2907 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2908 int boundary_seen = 0;
2910 *error_name = NULL;
2912 if (menu_items_n_panes > 1)
2914 *error_name = "Multiple panes in dialog box";
2915 return Qnil;
2918 /* Create a tree of widget_value objects
2919 representing the text label and buttons. */
2921 Lisp_Object pane_name, prefix;
2922 char *pane_string;
2923 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2924 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2925 pane_string = (NILP (pane_name)
2926 ? "" : (char *) SDATA (pane_name));
2927 prev_wv = xmalloc_widget_value ();
2928 prev_wv->value = pane_string;
2929 if (keymaps && !NILP (prefix))
2930 prev_wv->name++;
2931 prev_wv->enabled = 1;
2932 prev_wv->name = "message";
2933 prev_wv->help = Qnil;
2934 first_wv = prev_wv;
2936 /* Loop over all panes and items, filling in the tree. */
2937 i = MENU_ITEMS_PANE_LENGTH;
2938 while (i < menu_items_used)
2941 /* Create a new item within current pane. */
2942 Lisp_Object item_name, enable, descrip;
2943 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2944 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2945 descrip
2946 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2948 if (NILP (item_name))
2950 free_menubar_widget_value_tree (first_wv);
2951 *error_name = "Submenu in dialog items";
2952 return Qnil;
2954 if (EQ (item_name, Qquote))
2956 /* This is the boundary between left-side elts
2957 and right-side elts. Stop incrementing right_count. */
2958 boundary_seen = 1;
2959 i++;
2960 continue;
2962 if (nb_buttons >= 9)
2964 free_menubar_widget_value_tree (first_wv);
2965 *error_name = "Too many dialog items";
2966 return Qnil;
2969 wv = xmalloc_widget_value ();
2970 prev_wv->next = wv;
2971 wv->name = (char *) button_names[nb_buttons];
2972 if (!NILP (descrip))
2973 wv->key = (char *) SDATA (descrip);
2974 wv->value = (char *) SDATA (item_name);
2975 wv->call_data = (void *) i;
2976 /* menu item is identified by its index in menu_items table */
2977 wv->enabled = !NILP (enable);
2978 wv->help = Qnil;
2979 prev_wv = wv;
2981 if (! boundary_seen)
2982 left_count++;
2984 nb_buttons++;
2985 i += MENU_ITEMS_ITEM_LENGTH;
2988 /* If the boundary was not specified,
2989 by default put half on the left and half on the right. */
2990 if (! boundary_seen)
2991 left_count = nb_buttons - nb_buttons / 2;
2993 wv = xmalloc_widget_value ();
2994 wv->name = dialog_name;
2995 wv->help = Qnil;
2997 /* Frame title: 'Q' = Question, 'I' = Information.
2998 Can also have 'E' = Error if, one day, we want
2999 a popup for errors. */
3000 if (NILP(header))
3001 dialog_name[0] = 'Q';
3002 else
3003 dialog_name[0] = 'I';
3005 /* Dialog boxes use a really stupid name encoding
3006 which specifies how many buttons to use
3007 and how many buttons are on the right. */
3008 dialog_name[1] = '0' + nb_buttons;
3009 dialog_name[2] = 'B';
3010 dialog_name[3] = 'R';
3011 /* Number of buttons to put on the right. */
3012 dialog_name[4] = '0' + nb_buttons - left_count;
3013 dialog_name[5] = 0;
3014 wv->contents = first_wv;
3015 first_wv = wv;
3018 /* Force a redisplay before showing the dialog. If a frame is created
3019 just before showing the dialog, its contents may not have been fully
3020 drawn. */
3021 Fredisplay (Qt);
3023 /* Actually create the dialog. */
3024 #if TARGET_API_MAC_CARBON
3025 menu_item_selection = create_and_show_dialog (f, first_wv);
3026 #else
3027 menu_item_selection = mac_dialog (first_wv);
3028 #endif
3030 /* Free the widget_value objects we used to specify the contents. */
3031 free_menubar_widget_value_tree (first_wv);
3033 /* Find the selected item, and its pane, to return
3034 the proper value. */
3035 if (menu_item_selection != 0)
3037 Lisp_Object prefix;
3039 prefix = Qnil;
3040 i = 0;
3041 while (i < menu_items_used)
3043 Lisp_Object entry;
3045 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
3047 prefix
3048 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
3049 i += MENU_ITEMS_PANE_LENGTH;
3051 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
3053 /* This is the boundary between left-side elts and
3054 right-side elts. */
3055 ++i;
3057 else
3059 entry
3060 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
3061 if (menu_item_selection == i)
3063 if (keymaps != 0)
3065 entry = Fcons (entry, Qnil);
3066 if (!NILP (prefix))
3067 entry = Fcons (prefix, entry);
3069 return entry;
3071 i += MENU_ITEMS_ITEM_LENGTH;
3075 else
3076 /* Make "Cancel" equivalent to C-g. */
3077 Fsignal (Qquit, Qnil);
3079 return Qnil;
3081 #endif /* HAVE_DIALOGS */
3084 /* Is this item a separator? */
3085 static int
3086 name_is_separator (name)
3087 const char *name;
3089 const char *start = name;
3091 /* Check if name string consists of only dashes ('-'). */
3092 while (*name == '-') name++;
3093 /* Separators can also be of the form "--:TripleSuperMegaEtched"
3094 or "--deep-shadow". We don't implement them yet, se we just treat
3095 them like normal separators. */
3096 return (*name == '\0' || start + 2 == name);
3099 static void
3100 add_menu_item (menu, pos, wv)
3101 MenuRef menu;
3102 int pos;
3103 widget_value *wv;
3105 #if TARGET_API_MAC_CARBON
3106 CFStringRef item_name;
3107 #else
3108 Str255 item_name;
3109 #endif
3111 if (name_is_separator (wv->name))
3112 AppendMenu (menu, "\p-");
3113 else
3115 AppendMenu (menu, "\pX");
3117 #if TARGET_API_MAC_CARBON
3118 item_name = cfstring_create_with_utf8_cstring (wv->name);
3120 if (wv->key != NULL)
3122 CFStringRef name, key;
3124 name = item_name;
3125 key = cfstring_create_with_utf8_cstring (wv->key);
3126 item_name = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@ %@"),
3127 name, key);
3128 CFRelease (name);
3129 CFRelease (key);
3132 SetMenuItemTextWithCFString (menu, pos, item_name);
3133 CFRelease (item_name);
3135 if (wv->enabled)
3136 EnableMenuItem (menu, pos);
3137 else
3138 DisableMenuItem (menu, pos);
3140 if (STRINGP (wv->help))
3141 SetMenuItemProperty (menu, pos, MAC_EMACS_CREATOR_CODE, 'help',
3142 sizeof (Lisp_Object), &wv->help);
3143 #else /* ! TARGET_API_MAC_CARBON */
3144 item_name[sizeof (item_name) - 1] = '\0';
3145 strncpy (item_name, wv->name, sizeof (item_name) - 1);
3146 if (wv->key != NULL)
3148 int len = strlen (item_name);
3150 strncpy (item_name + len, " ", sizeof (item_name) - 1 - len);
3151 len = strlen (item_name);
3152 strncpy (item_name + len, wv->key, sizeof (item_name) - 1 - len);
3154 c2pstr (item_name);
3155 SetMenuItemText (menu, pos, item_name);
3157 if (wv->enabled)
3158 EnableItem (menu, pos);
3159 else
3160 DisableItem (menu, pos);
3161 #endif /* ! TARGET_API_MAC_CARBON */
3163 /* Draw radio buttons and tickboxes. */
3164 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
3165 wv->button_type == BUTTON_TYPE_RADIO))
3166 SetItemMark (menu, pos, checkMark);
3167 else
3168 SetItemMark (menu, pos, noMark);
3170 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
3174 /* Construct native Mac OS menu based on widget_value tree. */
3176 static int
3177 fill_menu (menu, wv, kind, submenu_id)
3178 MenuRef menu;
3179 widget_value *wv;
3180 enum mac_menu_kind kind;
3181 int submenu_id;
3183 int pos;
3185 for (pos = 1; wv != NULL; wv = wv->next, pos++)
3187 add_menu_item (menu, pos, wv);
3188 if (wv->contents && submenu_id < min_menu_id[kind + 1])
3190 MenuRef submenu = NewMenu (submenu_id, "\pX");
3192 InsertMenu (submenu, -1);
3193 SetMenuItemHierarchicalID (menu, pos, submenu_id);
3194 submenu_id = fill_menu (submenu, wv->contents, kind, submenu_id + 1);
3198 return submenu_id;
3201 /* Construct native Mac OS menubar based on widget_value tree. */
3203 static void
3204 fill_menubar (wv, deep_p)
3205 widget_value *wv;
3206 int deep_p;
3208 int id, submenu_id;
3209 #if !TARGET_API_MAC_CARBON
3210 int title_changed_p = 0;
3211 #endif
3213 /* Clean up the menu bar when filled by the entire menu trees. */
3214 if (deep_p)
3216 dispose_menus (MAC_MENU_MENU_BAR, 0);
3217 dispose_menus (MAC_MENU_MENU_BAR_SUB, 0);
3218 #if !TARGET_API_MAC_CARBON
3219 title_changed_p = 1;
3220 #endif
3223 /* Fill menu bar titles and submenus. Reuse the existing menu bar
3224 titles as much as possible to minimize redraw (if !deep_p). */
3225 submenu_id = min_menu_id[MAC_MENU_MENU_BAR_SUB];
3226 for (id = min_menu_id[MAC_MENU_MENU_BAR];
3227 wv != NULL && id < min_menu_id[MAC_MENU_MENU_BAR + 1];
3228 wv = wv->next, id++)
3230 OSStatus err = noErr;
3231 MenuRef menu;
3232 #if TARGET_API_MAC_CARBON
3233 CFStringRef title;
3235 title = CFStringCreateWithCString (NULL, wv->name,
3236 kCFStringEncodingMacRoman);
3237 #else
3238 Str255 title;
3240 strncpy (title, wv->name, 255);
3241 title[255] = '\0';
3242 c2pstr (title);
3243 #endif
3245 menu = GetMenuRef (id);
3246 if (menu)
3248 #if TARGET_API_MAC_CARBON
3249 CFStringRef old_title;
3251 err = CopyMenuTitleAsCFString (menu, &old_title);
3252 if (err == noErr)
3254 if (CFStringCompare (title, old_title, 0) != kCFCompareEqualTo)
3255 err = SetMenuTitleWithCFString (menu, title);
3256 CFRelease (old_title);
3258 else
3259 err = SetMenuTitleWithCFString (menu, title);
3260 #else /* !TARGET_API_MAC_CARBON */
3261 if (!EqualString (title, (*menu)->menuData, false, false))
3263 DeleteMenu (id);
3264 DisposeMenu (menu);
3265 menu = NewMenu (id, title);
3266 InsertMenu (menu, GetMenuRef (id + 1) ? id + 1 : 0);
3267 title_changed_p = 1;
3269 #endif /* !TARGET_API_MAC_CARBON */
3271 else
3273 #if TARGET_API_MAC_CARBON
3274 err = CreateNewMenu (id, 0, &menu);
3275 if (err == noErr)
3276 err = SetMenuTitleWithCFString (menu, title);
3277 #else
3278 menu = NewMenu (id, title);
3279 #endif
3280 if (err == noErr)
3282 InsertMenu (menu, 0);
3283 #if !TARGET_API_MAC_CARBON
3284 title_changed_p = 1;
3285 #endif
3288 #if TARGET_API_MAC_CARBON
3289 CFRelease (title);
3290 #endif
3292 if (err == noErr)
3293 if (wv->contents)
3294 submenu_id = fill_menu (menu, wv->contents, MAC_MENU_MENU_BAR_SUB,
3295 submenu_id);
3298 if (id < min_menu_id[MAC_MENU_MENU_BAR + 1] && GetMenuRef (id))
3300 dispose_menus (MAC_MENU_MENU_BAR, id);
3301 #if !TARGET_API_MAC_CARBON
3302 title_changed_p = 1;
3303 #endif
3306 #if !TARGET_API_MAC_CARBON
3307 if (title_changed_p)
3308 InvalMenuBar ();
3309 #endif
3312 /* Dispose of menus that belong to KIND, and remove them from the menu
3313 list. ID is the lower bound of menu IDs that will be processed. */
3315 static void
3316 dispose_menus (kind, id)
3317 enum mac_menu_kind kind;
3318 int id;
3320 for (id = max (id, min_menu_id[kind]); id < min_menu_id[kind + 1]; id++)
3322 MenuRef menu = GetMenuRef (id);
3324 if (menu == NULL)
3325 break;
3326 DeleteMenu (id);
3327 DisposeMenu (menu);
3331 #endif /* HAVE_MENUS */
3333 /* Detect if a menu is currently active. */
3336 popup_activated ()
3338 return popup_activated_flag;
3341 /* The following is used by delayed window autoselection. */
3343 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
3344 doc: /* Return t if a menu or popup dialog is active. */)
3347 #if TARGET_API_MAC_CARBON
3348 return (popup_activated ()) ? Qt : Qnil;
3349 #else
3350 /* Always return Qnil since menu selection functions do not return
3351 until a selection has been made or cancelled. */
3352 return Qnil;
3353 #endif
3356 void
3357 syms_of_macmenu ()
3359 staticpro (&menu_items);
3360 menu_items = Qnil;
3362 Qdebug_on_next_call = intern ("debug-on-next-call");
3363 staticpro (&Qdebug_on_next_call);
3365 defsubr (&Sx_popup_menu);
3366 defsubr (&Smenu_or_popup_active_p);
3367 #ifdef HAVE_MENUS
3368 defsubr (&Sx_popup_dialog);
3369 #endif
3372 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
3373 (do not change this comment) */