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 3, or (at your option)
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). */
29 #include "termhooks.h"
34 #include "blockinput.h"
39 #if !TARGET_API_MAC_CARBON
42 #include <QuickDraw.h>
43 #include <ToolUtils.h>
48 #if defined (__MRC__) || (__MSL__ >= 0x6000)
49 #include <ControlDefinitions.h>
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. */
57 /* Load sys/types.h if not already loaded.
58 In some systems loading it twice is suicidal. */
60 #include <sys/types.h>
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
84 #undef HAVE_MULTILINGUAL_MENU
86 /******************************************************************/
87 /* Definitions copied from lwlib.h */
89 typedef void * XtPointer
;
98 /* This structure is based on the one in ../lwlib/lwlib.h, modified
100 typedef struct _widget_value
105 /* value (meaning depend on widget type) */
107 /* keyboard equivalent. no implications for XtTranslations */
110 /* Help string or nil if none.
111 GC finds this string through the frame's menu_bar_vector
112 or through menu_items. */
114 /* true if enabled */
116 /* true if selected */
118 /* The type of a button. */
119 enum button_type button_type
;
120 /* true if menu title */
123 /* true if was edited (maintained by get_value) */
125 /* true if has changed (maintained by lw library) */
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
;
131 /* Contents of the sub-widgets, also selected slot for checkbox */
132 struct _widget_value
* contents
;
133 /* data passed to callback */
135 /* next one in the list */
136 struct _widget_value
* next
;
138 /* slot for the toolkit dependent part. Always initialize to NULL. */
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
;
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 /******************************************************************/
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)
183 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
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
));
190 static Lisp_Object mac_dialog_show
P_ ((FRAME_PTR
, int, Lisp_Object
,
191 Lisp_Object
, char **));
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
,
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
,
203 static int fill_menu
P_ ((MenuHandle
, 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
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. */
280 if (NILP (menu_items
))
282 menu_items_allocated
= 60;
283 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
287 menu_items_n_panes
= 0;
288 menu_items_submenu_depth
= 0;
291 /* Call at the end of generating the data in menu_items. */
298 /* Call when finished using the data for the current menu
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)
309 menu_items_allocated
= 0;
313 /* This undoes save_menu_items, and it is called by the specpdl unwind
317 restore_menu_items (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
));
331 /* Push the whole state of menu_items processing onto the specpdl.
332 It will be restored when the specpdl is unwound. */
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
);
345 /* Make the menu_items vector twice as large. */
351 int old_size
= menu_items_allocated
;
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. */
364 push_submenu_start ()
366 if (menu_items_used
+ 1 > menu_items_allocated
)
369 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
370 menu_items_submenu_depth
++;
378 if (menu_items_used
+ 1 > menu_items_allocated
)
381 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
382 menu_items_submenu_depth
--;
385 /* Indicate boundary between left and right. */
388 push_left_right_boundary ()
390 if (menu_items_used
+ 1 > menu_items_allocated
)
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. */
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
)
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'. */
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
)
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. */
444 keymap_panes (keymaps
, nmaps
, notreal
)
445 Lisp_Object
*keymaps
;
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. */
466 Lisp_Object pending_maps
;
467 int maxdepth
, notreal
;
470 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
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. */
483 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
485 Lisp_Object pane_name
;
493 skp
.pending_maps
= Qnil
;
494 skp
.maxdepth
= maxdepth
;
495 skp
.notreal
= notreal
;
500 push_menu_pane (pane_name
, prefix
);
502 GCPRO1 (skp
.pending_maps
);
503 map_keymap (keymap
, single_menu_item
, Qnil
, &skp
, 1);
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
);
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
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
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. */
531 single_menu_item (key
, item
, dummy
, skp_v
)
532 Lisp_Object key
, item
, dummy
;
535 Lisp_Object map
, item_string
, enabled
;
536 struct gcpro gcpro1
, gcpro2
;
538 struct skp
*skp
= skp_v
;
540 /* Parse the menu item and leave the result in item_properties. */
542 res
= parse_menu_item (item
, skp
->notreal
, 0);
545 return; /* Not a menu item. */
547 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
551 /* We don't want to make a menu, just traverse the keymaps to
552 precompute equivalent key bindings. */
554 single_keymap_panes (map
, Qnil
, key
, 1, skp
->maxdepth
- 1);
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) == '@')
564 /* An enabled separate pane. Remember this to handle it later. */
565 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
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);
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. */
598 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
600 Lisp_Object elt
, pane_name
, pane_data
;
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. */
619 Lisp_Object tail
, item
, item1
;
621 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
625 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
626 Qnil
, Qnil
, Qnil
, Qnil
);
627 else if (CONSP (item
))
630 CHECK_STRING (item1
);
631 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
632 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
635 push_left_right_boundary ();
641 cleanup_popup_menu (arg
)
644 discard_menu_items ();
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
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
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. */)
692 Lisp_Object position
, menu
;
694 Lisp_Object keymap
, tem
;
695 int xpos
= 0, ypos
= 0;
697 char *error_name
= NULL
;
698 Lisp_Object selection
;
700 Lisp_Object x
, y
, window
;
703 int specpdl_count
= SPECPDL_INDEX ();
707 if (! NILP (position
))
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
;
723 if (mouse_position_hook
)
724 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
725 &part
, &x
, &y
, &time
);
727 XSETFRAME (window
, new_f
);
730 window
= selected_window
;
737 tem
= Fcar (position
);
740 window
= Fcar (Fcdr (position
));
742 y
= Fcar (XCDR (tem
));
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) */
758 /* Decode where to put the menu. */
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
));
775 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
776 but I don't want to make one now. */
777 CHECK_WINDOW (window
);
782 XSETFRAME (Vmenu_updating_frame
, f
);
785 Vmenu_updating_frame
= Qnil
;
786 #endif /* HAVE_MENUS */
791 /* Decode the menu items from what was specified. */
793 keymap
= get_keymap (menu
, 0, 0);
796 /* We were given a keymap. Extract menu info from the keymap. */
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
))
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
;
814 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
816 /* We were given a list of keymaps. */
817 int nmaps
= XFASTINT (Flength (menu
));
819 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
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
))
830 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
832 prompt
= Fkeymap_prompt (keymap
);
833 if (NILP (title
) && !NILP (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
;
848 /* We were given an old-fashioned menu. */
850 CHECK_STRING (title
);
852 list_of_panes (Fcdr (menu
));
859 discard_menu_items ();
865 /* Display them in a menu. */
866 record_unwind_protect (cleanup_popup_menu
, Qnil
);
869 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
870 keymaps
, title
, &error_name
);
872 unbind_to (specpdl_count
, Qnil
);
875 #endif /* HAVE_MENUS */
877 if (error_name
) error (error_name
);
883 /* Regard ESC and C-g as Cancel even without the Cancel button. */
887 mac_dialog_modal_filter (dialog
, event
, item_hit
)
890 DialogItemIndex
*item_hit
;
894 result
= StdFilterProc (dialog
, event
, item_hit
);
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
;
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
;
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
;
954 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
957 XSETFRAME (window
, new_f
);
959 window
= selected_window
;
961 window
= selected_window
;
963 else if (CONSP (position
))
966 tem
= Fcar (position
);
968 window
= Fcar (Fcdr (position
));
971 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
972 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
975 else if (WINDOWP (position
) || FRAMEP (position
))
980 /* Decode where to put the menu. */
984 else if (WINDOWP (window
))
986 CHECK_LIVE_WINDOW (window
);
987 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
990 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
991 but I don't want to make one now. */
992 CHECK_WINDOW (window
);
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
)))
1001 || (!NILP (Fequal (XCDR (contents
),
1002 Fcons (Fcons (build_string ("Yes"), Qt
),
1003 Fcons (Fcons (build_string ("No"), Qnil
),
1007 OSStatus err
= noErr
;
1008 AlertStdCFStringAlertParamRec param
;
1009 CFStringRef error_string
, explanation_string
;
1011 DialogItemIndex item_hit
;
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. */
1019 tem
= Fstring_match (concat3 (build_string ("\\("),
1020 call0 (intern ("sentence-end")),
1021 build_string ("\\)\n")),
1022 XCAR (contents
), Qnil
);
1026 error_string
= cfstring_create_with_string (XCAR (contents
));
1027 if (error_string
== NULL
)
1029 explanation_string
= NULL
;
1033 tem
= Fmatch_end (make_number (1));
1035 cfstring_create_with_string (Fsubstring (XCAR (contents
),
1036 make_number (0), tem
));
1037 if (error_string
== NULL
)
1041 XSETINT (tem
, XINT (tem
) + 1);
1042 explanation_string
=
1043 cfstring_create_with_string (Fsubstring (XCAR (contents
),
1045 if (explanation_string
== NULL
)
1047 CFRelease (error_string
);
1053 err
= GetStandardAlertDefaultParams (¶m
,
1054 kStdCFStringAlertVersionOne
);
1057 param
.movable
= true;
1058 param
.position
= kWindowAlertPositionParentWindow
;
1061 param
.defaultText
= CFSTR ("Yes");
1062 param
.otherText
= CFSTR ("No");
1064 param
.cancelText
= CFSTR ("Cancel");
1065 param
.cancelButton
= kAlertStdAlertCancelButton
;
1068 err
= CreateStandardAlert (kAlertNoteAlert
, error_string
,
1069 explanation_string
, ¶m
, &alert
);
1070 CFRelease (error_string
);
1071 if (explanation_string
)
1072 CFRelease (explanation_string
);
1075 err
= RunStandardAlert (alert
, mac_dialog_modal_filter
, &item_hit
);
1080 if (item_hit
== kStdCancelItemIndex
)
1081 Fsignal (Qquit
, Qnil
);
1082 else if (item_hit
== kStdOkItemIndex
)
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 */
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
);
1118 selection
= mac_dialog_show (f
, 0, title
, header
, &error_name
);
1120 unbind_to (specpdl_count
, Qnil
);
1122 if (error_name
) error (error_name
);
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. */
1142 x_activate_menubar (f
)
1146 SInt16 menu_id
, menu_item
;
1147 extern Point saved_menu_event_location
;
1149 set_frame_menubar (f
, 0, 1);
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
);
1165 MenuHandle menu
= GetMenuHandle (menu_id
);
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
);
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. */
1188 find_and_call_menu_selection (f
, menu_bar_items_used
, vector
, client_data
)
1190 int menu_bar_items_used
;
1194 Lisp_Object prefix
, entry
;
1195 Lisp_Object
*subprefix_stack
;
1196 int submenu_depth
= 0;
1200 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
1204 while (i
< menu_bar_items_used
)
1206 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1208 subprefix_stack
[submenu_depth
++] = prefix
;
1212 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1214 prefix
= subprefix_stack
[--submenu_depth
];
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
;
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
)
1230 struct input_event buf
;
1234 XSETFRAME (frame
, f
);
1235 buf
.kind
= MENU_BAR_EVENT
;
1236 buf
.frame_or_window
= 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
);
1251 buf
.kind
= MENU_BAR_EVENT
;
1252 buf
.frame_or_window
= frame
;
1254 kbd_buffer_store_event (&buf
);
1257 buf
.kind
= MENU_BAR_EVENT
;
1258 buf
.frame_or_window
= frame
;
1260 kbd_buffer_store_event (&buf
);
1264 i
+= MENU_ITEMS_ITEM_LENGTH
;
1269 /* Allocate a widget_value, blocking input. */
1272 xmalloc_widget_value ()
1274 widget_value
*value
;
1277 value
= malloc_widget_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. */
1289 free_menubar_widget_value_tree (wv
)
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;
1303 free_menubar_widget_value_tree (wv
->next
);
1304 wv
->next
= (widget_value
*) 0xDEADBEEF;
1307 free_widget_value (wv
);
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. */
1316 parse_single_submenu (item_key
, item_name
, maps
)
1317 Lisp_Object item_key
, item_name
, maps
;
1321 Lisp_Object
*mapvec
;
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
);
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
);
1352 prompt
= Fkeymap_prompt (mapvec
[i
]);
1353 single_keymap_panes (mapvec
[i
],
1354 !NILP (prompt
) ? prompt
: item_name
,
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
;
1372 int submenu_depth
= 0;
1373 widget_value
**submenu_stack
;
1377 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1378 wv
= xmalloc_widget_value ();
1382 wv
->button_type
= BUTTON_TYPE_NONE
;
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. */
1395 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1397 submenu_stack
[submenu_depth
++] = save_wv
;
1402 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1405 save_wv
= submenu_stack
[--submenu_depth
];
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
))
1415 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1417 /* Create a new pane. */
1418 Lisp_Object pane_name
, prefix
;
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
;
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)
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 ();
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;
1454 wv
->button_type
= BUTTON_TYPE_NONE
;
1462 i
+= MENU_ITEMS_PANE_LENGTH
;
1466 /* Create a new item within current pane. */
1467 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1470 /* All items should be contained in panes. */
1471 if (panes_seen
== 0)
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 ();
1500 save_wv
->contents
= wv
;
1502 wv
->lname
= item_name
;
1503 if (!NILP (descrip
))
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
);
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
;
1520 wv
->selected
= !NILP (selected
);
1521 if (! STRINGP (help
))
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
);
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. */
1550 update_submenu_strings (first_wv
)
1551 widget_value
*first_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] == '@')
1571 if (STRINGP (wv
->lkey
))
1572 wv
->key
= SDATA (wv
->lkey
);
1575 update_submenu_strings (wv
->contents
);
1580 #if TARGET_API_MAC_CARBON
1581 extern Lisp_Object Vshow_help_function
;
1584 restore_show_help_function (old_show_help_function
)
1585 Lisp_Object old_show_help_function
;
1587 Vshow_help_function
= old_show_help_function
;
1592 static pascal OSStatus
1593 menu_target_item_handler (next_handler
, event
, data
)
1594 EventHandlerCallRef next_handler
;
1598 OSStatus err
, result
;
1600 MenuItemIndex menu_item
;
1603 int specpdl_count
= SPECPDL_INDEX ();
1605 result
= CallNextEventHandler (next_handler
, event
);
1607 err
= GetEventParameter (event
, kEventParamDirectObject
, typeMenuRef
,
1608 NULL
, sizeof (MenuRef
), NULL
, &menu
);
1610 err
= GetEventParameter (event
, kEventParamMenuItemIndex
,
1611 typeMenuItemIndex
, NULL
,
1612 sizeof (MenuItemIndex
), NULL
, &menu_item
);
1614 err
= GetMenuItemProperty (menu
, menu_item
,
1615 MAC_EMACS_CREATOR_CODE
, 'help',
1616 sizeof (Lisp_Object
), NULL
, &help
);
1620 /* Temporarily bind Vshow_help_function to Qnil because we don't
1621 want tooltips during menu tracking. */
1622 record_unwind_protect (restore_show_help_function
, Vshow_help_function
);
1623 Vshow_help_function
= Qnil
;
1625 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1627 unbind_to (specpdl_count
, Qnil
);
1629 return err
== noErr
? noErr
: result
;
1634 install_menu_target_item_handler (window
)
1637 OSStatus err
= noErr
;
1638 #if TARGET_API_MAC_CARBON
1639 static const EventTypeSpec specs
[] =
1640 {{kEventClassMenu
, kEventMenuTargetItem
}};
1641 static EventHandlerUPP menu_target_item_handlerUPP
= NULL
;
1643 if (menu_target_item_handlerUPP
== NULL
)
1644 menu_target_item_handlerUPP
=
1645 NewEventHandlerUPP (menu_target_item_handler
);
1647 err
= InstallWindowEventHandler (window
, menu_target_item_handlerUPP
,
1648 GetEventTypeCount (specs
), specs
,
1654 /* Event handler function that pops down a menu on C-g. We can only pop
1655 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1657 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1658 static pascal OSStatus
1659 menu_quit_handler (nextHandler
, theEvent
, userData
)
1660 EventHandlerCallRef nextHandler
;
1666 UInt32 keyModifiers
;
1668 err
= GetEventParameter (theEvent
, kEventParamKeyCode
,
1669 typeUInt32
, NULL
, sizeof(UInt32
), NULL
, &keyCode
);
1672 err
= GetEventParameter (theEvent
, kEventParamKeyModifiers
,
1673 typeUInt32
, NULL
, sizeof(UInt32
),
1674 NULL
, &keyModifiers
);
1676 if (err
== noErr
&& mac_quit_char_key_p (keyModifiers
, keyCode
))
1678 MenuRef menu
= userData
!= 0
1679 ? (MenuRef
)userData
: AcquireRootMenu ();
1681 CancelMenuTracking (menu
, true, 0);
1682 if (!userData
) ReleaseMenu (menu
);
1686 return CallNextEventHandler (nextHandler
, theEvent
);
1688 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1690 /* Add event handler to all menus that belong to KIND so we can detect C-g.
1691 MENU_HANDLE is the root menu of the tracking session to dismiss
1692 when C-g is detected. NULL means the menu bar.
1693 If CancelMenuTracking isn't available, do nothing. */
1696 install_menu_quit_handler (kind
, menu_handle
)
1697 enum mac_menu_kind kind
;
1698 MenuHandle menu_handle
;
1700 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1701 static const EventTypeSpec typesList
[] =
1702 {{kEventClassKeyboard
, kEventRawKeyDown
}};
1705 #if MAC_OS_X_VERSION_MIN_REQUIRED == 1020
1706 if (CancelMenuTracking
== NULL
)
1709 for (id
= min_menu_id
[kind
]; id
< min_menu_id
[kind
+ 1]; id
++)
1711 MenuHandle menu
= GetMenuHandle (id
);
1715 InstallMenuEventHandler (menu
, menu_quit_handler
,
1716 GetEventTypeCount (typesList
),
1717 typesList
, menu_handle
, NULL
);
1719 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1722 /* Set the contents of the menubar widgets of frame F.
1723 The argument FIRST_TIME is currently ignored;
1724 it is set the first time this is called, from initialize_frame_menubar. */
1727 set_frame_menubar (f
, first_time
, deep_p
)
1732 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1734 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1736 int *submenu_start
, *submenu_end
;
1737 int *submenu_top_level_items
, *submenu_n_panes
;
1739 XSETFRAME (Vmenu_updating_frame
, f
);
1741 if (! menubar_widget
)
1743 else if (pending_menu_activation
&& !deep_p
)
1748 /* Make a widget-value tree representing the entire menu trees. */
1750 struct buffer
*prev
= current_buffer
;
1752 int specpdl_count
= SPECPDL_INDEX ();
1753 int previous_menu_items_used
= f
->menu_bar_items_used
;
1754 Lisp_Object
*previous_items
1755 = (Lisp_Object
*) alloca (previous_menu_items_used
1756 * sizeof (Lisp_Object
));
1758 /* If we are making a new widget, its contents are empty,
1759 do always reinitialize them. */
1760 if (! menubar_widget
)
1761 previous_menu_items_used
= 0;
1763 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1764 specbind (Qinhibit_quit
, Qt
);
1765 /* Don't let the debugger step into this code
1766 because it is not reentrant. */
1767 specbind (Qdebug_on_next_call
, Qnil
);
1769 record_unwind_save_match_data ();
1770 if (NILP (Voverriding_local_map_menu_flag
))
1772 specbind (Qoverriding_terminal_local_map
, Qnil
);
1773 specbind (Qoverriding_local_map
, Qnil
);
1776 set_buffer_internal_1 (XBUFFER (buffer
));
1778 /* Run the Lucid hook. */
1779 safe_run_hooks (Qactivate_menubar_hook
);
1781 /* If it has changed current-menubar from previous value,
1782 really recompute the menubar from the value. */
1783 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1784 call0 (Qrecompute_lucid_menubar
);
1785 safe_run_hooks (Qmenu_bar_update_hook
);
1786 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1788 items
= FRAME_MENU_BAR_ITEMS (f
);
1790 /* Save the frame's previous menu bar contents data. */
1791 if (previous_menu_items_used
)
1792 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1793 previous_menu_items_used
* sizeof (Lisp_Object
));
1795 /* Fill in menu_items with the current menu bar contents.
1796 This can evaluate Lisp code. */
1799 menu_items
= f
->menu_bar_vector
;
1800 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1801 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1802 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1803 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1804 submenu_top_level_items
1805 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1807 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1809 Lisp_Object key
, string
, maps
;
1813 key
= XVECTOR (items
)->contents
[i
];
1814 string
= XVECTOR (items
)->contents
[i
+ 1];
1815 maps
= XVECTOR (items
)->contents
[i
+ 2];
1819 submenu_start
[i
] = menu_items_used
;
1821 menu_items_n_panes
= 0;
1822 submenu_top_level_items
[i
]
1823 = parse_single_submenu (key
, string
, maps
);
1824 submenu_n_panes
[i
] = menu_items_n_panes
;
1826 submenu_end
[i
] = menu_items_used
;
1829 finish_menu_items ();
1831 /* Convert menu_items into widget_value trees
1832 to display the menu. This cannot evaluate Lisp code. */
1834 wv
= xmalloc_widget_value ();
1835 wv
->name
= "menubar";
1838 wv
->button_type
= BUTTON_TYPE_NONE
;
1842 for (i
= 0; i
< last_i
; i
+= 4)
1844 menu_items_n_panes
= submenu_n_panes
[i
];
1845 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1846 submenu_top_level_items
[i
]);
1850 first_wv
->contents
= wv
;
1851 /* Don't set wv->name here; GC during the loop might relocate it. */
1853 wv
->button_type
= BUTTON_TYPE_NONE
;
1857 set_buffer_internal_1 (prev
);
1859 /* If there has been no change in the Lisp-level contents
1860 of the menu bar, skip redisplaying it. Just exit. */
1862 /* Compare the new menu items with the ones computed last time. */
1863 for (i
= 0; i
< previous_menu_items_used
; i
++)
1864 if (menu_items_used
== i
1865 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1867 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1869 /* The menu items have not changed. Don't bother updating
1870 the menus in any form, since it would be a no-op. */
1871 free_menubar_widget_value_tree (first_wv
);
1872 discard_menu_items ();
1873 unbind_to (specpdl_count
, Qnil
);
1877 /* The menu items are different, so store them in the frame. */
1878 f
->menu_bar_vector
= menu_items
;
1879 f
->menu_bar_items_used
= menu_items_used
;
1881 /* This calls restore_menu_items to restore menu_items, etc.,
1882 as they were outside. */
1883 unbind_to (specpdl_count
, Qnil
);
1885 /* Now GC cannot happen during the lifetime of the widget_value,
1886 so it's safe to store data from a Lisp_String. */
1887 wv
= first_wv
->contents
;
1888 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1891 string
= XVECTOR (items
)->contents
[i
+ 1];
1894 wv
->name
= (char *) SDATA (string
);
1895 update_submenu_strings (wv
->contents
);
1902 /* Make a widget-value tree containing
1903 just the top level menu bar strings. */
1905 wv
= xmalloc_widget_value ();
1906 wv
->name
= "menubar";
1909 wv
->button_type
= BUTTON_TYPE_NONE
;
1913 items
= FRAME_MENU_BAR_ITEMS (f
);
1914 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1918 string
= XVECTOR (items
)->contents
[i
+ 1];
1922 wv
= xmalloc_widget_value ();
1923 wv
->name
= (char *) SDATA (string
);
1926 wv
->button_type
= BUTTON_TYPE_NONE
;
1928 /* This prevents lwlib from assuming this
1929 menu item is really supposed to be empty. */
1930 /* The EMACS_INT cast avoids a warning.
1931 This value just has to be different from small integers. */
1932 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1937 first_wv
->contents
= wv
;
1941 /* Forget what we thought we knew about what is in the
1942 detailed contents of the menu bar menus.
1943 Changing the top level always destroys the contents. */
1944 f
->menu_bar_items_used
= 0;
1947 /* Create or update the menu bar widget. */
1951 /* Non-null value to indicate menubar has already been "created". */
1952 f
->output_data
.mac
->menubar_widget
= 1;
1954 fill_menubar (first_wv
->contents
, deep_p
);
1956 /* Add event handler so we can detect C-g. */
1957 install_menu_quit_handler (MAC_MENU_MENU_BAR
, NULL
);
1958 install_menu_quit_handler (MAC_MENU_MENU_BAR_SUB
, NULL
);
1959 free_menubar_widget_value_tree (first_wv
);
1964 /* Get rid of the menu bar of frame F, and free its storage.
1965 This is used when deleting a frame, and when turning off the menu bar. */
1968 free_frame_menubar (f
)
1971 f
->output_data
.mac
->menubar_widget
= 0;
1979 struct Lisp_Save_Value
*p
= XSAVE_VALUE (arg
);
1980 FRAME_PTR f
= p
->pointer
;
1981 MenuHandle menu
= GetMenuHandle (min_menu_id
[MAC_MENU_POPUP
]);
1985 /* Must reset this manually because the button release event is not
1986 passed to Emacs event loop. */
1987 FRAME_MAC_DISPLAY_INFO (f
)->grabbed
= 0;
1989 /* delete all menus */
1990 dispose_menus (MAC_MENU_POPUP_SUB
, 0);
1991 DeleteMenu (min_menu_id
[MAC_MENU_POPUP
]);
1999 /* Mac_menu_show actually displays a menu using the panes and items in
2000 menu_items and returns the value selected from it; we assume input
2001 is blocked by the caller. */
2003 /* F is the frame the menu is for.
2004 X and Y are the frame-relative specified position,
2005 relative to the inside upper left corner of the frame F.
2006 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2007 KEYMAPS is 1 if this menu was specified with keymaps;
2008 in that case, we return a list containing the chosen item's value
2009 and perhaps also the pane's prefix.
2010 TITLE is the specified menu title.
2011 ERROR is a place to store an error message string in case of failure.
2012 (We return nil on failure, but the value doesn't actually matter.) */
2015 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2025 int menu_item_choice
;
2026 UInt32 menu_item_selection
;
2029 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2030 widget_value
**submenu_stack
2031 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
2032 Lisp_Object
*subprefix_stack
2033 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
2034 int submenu_depth
= 0;
2037 int specpdl_count
= SPECPDL_INDEX ();
2041 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2043 *error
= "Empty menu";
2047 /* Create a tree of widget_value objects
2048 representing the panes and their items. */
2049 wv
= xmalloc_widget_value ();
2053 wv
->button_type
= BUTTON_TYPE_NONE
;
2058 /* Loop over all panes and items, filling in the tree. */
2060 while (i
< menu_items_used
)
2062 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2064 submenu_stack
[submenu_depth
++] = save_wv
;
2070 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2073 save_wv
= submenu_stack
[--submenu_depth
];
2077 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2078 && submenu_depth
!= 0)
2079 i
+= MENU_ITEMS_PANE_LENGTH
;
2080 /* Ignore a nil in the item list.
2081 It's meaningful only for dialog boxes. */
2082 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2084 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2086 /* Create a new pane. */
2087 Lisp_Object pane_name
, prefix
;
2090 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2091 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2093 #ifndef HAVE_MULTILINGUAL_MENU
2094 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2096 pane_name
= ENCODE_MENU_STRING (pane_name
);
2097 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2100 pane_string
= (NILP (pane_name
)
2101 ? "" : (char *) SDATA (pane_name
));
2102 /* If there is just one top-level pane, put all its items directly
2103 under the top-level menu. */
2104 if (menu_items_n_panes
== 1)
2107 /* If the pane has a meaningful name,
2108 make the pane a top-level menu item
2109 with its items as a submenu beneath it. */
2110 if (!keymaps
&& strcmp (pane_string
, ""))
2112 wv
= xmalloc_widget_value ();
2116 first_wv
->contents
= wv
;
2117 wv
->name
= pane_string
;
2118 if (keymaps
&& !NILP (prefix
))
2122 wv
->button_type
= BUTTON_TYPE_NONE
;
2127 else if (first_pane
)
2133 i
+= MENU_ITEMS_PANE_LENGTH
;
2137 /* Create a new item within current pane. */
2138 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2139 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2140 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2141 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2142 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2143 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2144 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2145 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2147 #ifndef HAVE_MULTILINGUAL_MENU
2148 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2150 item_name
= ENCODE_MENU_STRING (item_name
);
2151 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2154 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2156 descrip
= ENCODE_MENU_STRING (descrip
);
2157 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2159 #endif /* not HAVE_MULTILINGUAL_MENU */
2161 wv
= xmalloc_widget_value ();
2165 save_wv
->contents
= wv
;
2166 wv
->name
= (char *) SDATA (item_name
);
2167 if (!NILP (descrip
))
2168 wv
->key
= (char *) SDATA (descrip
);
2170 /* Use the contents index as call_data, since we are
2171 restricted to 16-bits. */
2172 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
2173 wv
->enabled
= !NILP (enable
);
2176 wv
->button_type
= BUTTON_TYPE_NONE
;
2177 else if (EQ (type
, QCtoggle
))
2178 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2179 else if (EQ (type
, QCradio
))
2180 wv
->button_type
= BUTTON_TYPE_RADIO
;
2184 wv
->selected
= !NILP (selected
);
2186 if (! STRINGP (help
))
2193 i
+= MENU_ITEMS_ITEM_LENGTH
;
2197 /* Deal with the title, if it is non-nil. */
2200 widget_value
*wv_title
= xmalloc_widget_value ();
2201 widget_value
*wv_sep
= xmalloc_widget_value ();
2203 /* Maybe replace this separator with a bitmap or owner-draw item
2204 so that it looks better. Having two separators looks odd. */
2205 wv_sep
->name
= "--";
2206 wv_sep
->next
= first_wv
->contents
;
2207 wv_sep
->help
= Qnil
;
2209 #ifndef HAVE_MULTILINGUAL_MENU
2210 if (STRING_MULTIBYTE (title
))
2211 title
= ENCODE_MENU_STRING (title
);
2214 wv_title
->name
= (char *) SDATA (title
);
2215 wv_title
->enabled
= FALSE
;
2216 wv_title
->title
= TRUE
;
2217 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2218 wv_title
->help
= Qnil
;
2219 wv_title
->next
= wv_sep
;
2220 first_wv
->contents
= wv_title
;
2223 /* Actually create the menu. */
2224 menu
= NewMenu (min_menu_id
[MAC_MENU_POPUP
], "\p");
2225 InsertMenu (menu
, -1);
2226 fill_menu (menu
, first_wv
->contents
, MAC_MENU_POPUP_SUB
,
2227 min_menu_id
[MAC_MENU_POPUP_SUB
]);
2229 /* Free the widget_value objects we used to specify the
2231 free_menubar_widget_value_tree (first_wv
);
2233 /* Adjust coordinates to be root-window-relative. */
2237 SetPortWindowPort (FRAME_MAC_WINDOW (f
));
2238 LocalToGlobal (&pos
);
2240 /* No selection has been chosen yet. */
2241 menu_item_selection
= 0;
2243 record_unwind_protect (pop_down_menu
, make_save_value (f
, 0));
2245 /* Add event handler so we can detect C-g. */
2246 install_menu_quit_handler (MAC_MENU_POPUP
, menu
);
2247 install_menu_quit_handler (MAC_MENU_POPUP_SUB
, menu
);
2249 /* Display the menu. */
2250 popup_activated_flag
= 1;
2251 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
2252 popup_activated_flag
= 0;
2254 /* Get the refcon to find the correct item */
2255 if (menu_item_choice
)
2257 MenuHandle sel_menu
= GetMenuHandle (HiWord (menu_item_choice
));
2260 GetMenuItemRefCon (sel_menu
, LoWord (menu_item_choice
),
2261 &menu_item_selection
);
2264 unbind_to (specpdl_count
, Qnil
);
2266 /* Find the selected item, and its pane, to return
2267 the proper value. */
2268 if (menu_item_selection
!= 0)
2270 Lisp_Object prefix
, entry
;
2272 prefix
= entry
= Qnil
;
2274 while (i
< menu_items_used
)
2276 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2278 subprefix_stack
[submenu_depth
++] = prefix
;
2282 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2284 prefix
= subprefix_stack
[--submenu_depth
];
2287 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2290 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2291 i
+= MENU_ITEMS_PANE_LENGTH
;
2293 /* Ignore a nil in the item list.
2294 It's meaningful only for dialog boxes. */
2295 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2300 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2301 if (menu_item_selection
== i
)
2307 entry
= Fcons (entry
, Qnil
);
2309 entry
= Fcons (prefix
, entry
);
2310 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2311 if (!NILP (subprefix_stack
[j
]))
2312 entry
= Fcons (subprefix_stack
[j
], entry
);
2316 i
+= MENU_ITEMS_ITEM_LENGTH
;
2320 else if (!for_click
)
2321 /* Make "Cancel" equivalent to C-g. */
2322 Fsignal (Qquit
, Qnil
);
2329 /* Construct native Mac OS dialog based on widget_value tree. */
2331 #if TARGET_API_MAC_CARBON
2333 static pascal OSStatus
2334 mac_handle_dialog_event (next_handler
, event
, data
)
2335 EventHandlerCallRef next_handler
;
2340 WindowRef window
= (WindowRef
) data
;
2342 switch (GetEventClass (event
))
2344 case kEventClassCommand
:
2348 err
= GetEventParameter (event
, kEventParamDirectObject
,
2349 typeHICommand
, NULL
, sizeof (HICommand
),
2352 if ((command
.commandID
& ~0xffff) == 'Bt\0\0')
2354 SetWRefCon (window
, command
.commandID
);
2355 err
= QuitAppModalLoopForWindow (window
);
2357 return err
== noErr
? noErr
: eventNotHandledErr
;
2360 return CallNextEventHandler (next_handler
, event
);
2364 case kEventClassKeyboard
:
2369 result
= CallNextEventHandler (next_handler
, event
);
2370 if (result
== noErr
)
2373 err
= GetEventParameter (event
, kEventParamKeyMacCharCodes
,
2374 typeChar
, NULL
, sizeof (char),
2379 case kEscapeCharCode
:
2380 err
= QuitAppModalLoopForWindow (window
);
2385 UInt32 modifiers
, key_code
;
2387 err
= GetEventParameter (event
, kEventParamKeyModifiers
,
2388 typeUInt32
, NULL
, sizeof (UInt32
),
2391 err
= GetEventParameter (event
, kEventParamKeyCode
,
2392 typeUInt32
, NULL
, sizeof (UInt32
),
2396 if (mac_quit_char_key_p (modifiers
, key_code
))
2397 err
= QuitAppModalLoopForWindow (window
);
2399 err
= eventNotHandledErr
;
2405 return err
== noErr
? noErr
: result
;
2415 install_dialog_event_handler (window
)
2418 static const EventTypeSpec specs
[] =
2419 {{kEventClassCommand
, kEventCommandProcess
},
2420 {kEventClassKeyboard
, kEventRawKeyDown
}};
2421 static EventHandlerUPP handle_dialog_eventUPP
= NULL
;
2423 if (handle_dialog_eventUPP
== NULL
)
2424 handle_dialog_eventUPP
= NewEventHandlerUPP (mac_handle_dialog_event
);
2425 return InstallWindowEventHandler (window
, handle_dialog_eventUPP
,
2426 GetEventTypeCount (specs
), specs
,
2430 #define DIALOG_LEFT_MARGIN (112)
2431 #define DIALOG_TOP_MARGIN (24)
2432 #define DIALOG_RIGHT_MARGIN (24)
2433 #define DIALOG_BOTTOM_MARGIN (20)
2434 #define DIALOG_MIN_INNER_WIDTH (338)
2435 #define DIALOG_MAX_INNER_WIDTH (564)
2436 #define DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE (12)
2437 #define DIALOG_BUTTON_BUTTON_VERTICAL_SPACE (12)
2438 #define DIALOG_BUTTON_MIN_WIDTH (68)
2439 #define DIALOG_TEXT_MIN_HEIGHT (50)
2440 #define DIALOG_TEXT_BUTTONS_VERTICAL_SPACE (10)
2441 #define DIALOG_ICON_WIDTH (64)
2442 #define DIALOG_ICON_HEIGHT (64)
2443 #define DIALOG_ICON_LEFT_MARGIN (24)
2444 #define DIALOG_ICON_TOP_MARGIN (15)
2447 create_and_show_dialog (f
, first_wv
)
2449 widget_value
*first_wv
;
2452 char *dialog_name
, *message
;
2453 int nb_buttons
, first_group_count
, i
, result
= 0;
2455 short buttons_height
, text_height
, inner_width
, inner_height
;
2456 Rect empty_rect
, *rects
;
2457 WindowRef window
= NULL
;
2458 ControlRef
*buttons
, default_button
= NULL
, text
;
2460 dialog_name
= first_wv
->name
;
2461 nb_buttons
= dialog_name
[1] - '0';
2462 first_group_count
= nb_buttons
- (dialog_name
[4] - '0');
2464 wv
= first_wv
->contents
;
2465 message
= wv
->value
;
2468 SetRect (&empty_rect
, 0, 0, 0, 0);
2470 /* Create dialog window. */
2471 err
= CreateNewWindow (kMovableModalWindowClass
,
2472 kWindowStandardHandlerAttribute
,
2473 &empty_rect
, &window
);
2475 err
= SetThemeWindowBackground (window
, kThemeBrushMovableModalBackground
,
2478 err
= SetWindowTitleWithCFString (window
, (dialog_name
[0] == 'Q'
2479 ? CFSTR ("Question")
2480 : CFSTR ("Information")));
2482 /* Create button controls and measure their optimal bounds. */
2485 buttons
= alloca (sizeof (ControlRef
) * nb_buttons
);
2486 rects
= alloca (sizeof (Rect
) * nb_buttons
);
2487 for (i
= 0; i
< nb_buttons
; i
++)
2489 CFStringRef label
= cfstring_create_with_utf8_cstring (wv
->value
);
2495 err
= CreatePushButtonControl (window
, &empty_rect
,
2496 label
, &buttons
[i
]);
2504 err
= DisableControl (buttons
[i
]);
2506 err
= DeactivateControl (buttons
[i
]);
2509 else if (default_button
== NULL
)
2510 default_button
= buttons
[i
];
2516 rects
[i
] = empty_rect
;
2517 err
= GetBestControlRect (buttons
[i
], &rects
[i
], &unused
);
2521 OffsetRect (&rects
[i
], -rects
[i
].left
, -rects
[i
].top
);
2522 if (rects
[i
].right
< DIALOG_BUTTON_MIN_WIDTH
)
2523 rects
[i
].right
= DIALOG_BUTTON_MIN_WIDTH
;
2524 else if (rects
[i
].right
> DIALOG_MAX_INNER_WIDTH
)
2525 rects
[i
].right
= DIALOG_MAX_INNER_WIDTH
;
2527 err
= SetControlCommandID (buttons
[i
],
2528 'Bt\0\0' + (int) wv
->call_data
);
2536 /* Layout buttons. rects[i] is set relative to the bottom-right
2537 corner of the inner box. */
2540 short bottom
, right
, max_height
, left_align_shift
;
2542 inner_width
= DIALOG_MIN_INNER_WIDTH
;
2543 bottom
= right
= max_height
= 0;
2544 for (i
= 0; i
< nb_buttons
; i
++)
2546 if (right
- rects
[i
].right
< - inner_width
)
2548 if (i
!= first_group_count
2549 && right
- rects
[i
].right
>= - DIALOG_MAX_INNER_WIDTH
)
2550 inner_width
= - (right
- rects
[i
].right
);
2553 bottom
-= max_height
+ DIALOG_BUTTON_BUTTON_VERTICAL_SPACE
;
2554 right
= max_height
= 0;
2557 if (max_height
< rects
[i
].bottom
)
2558 max_height
= rects
[i
].bottom
;
2559 OffsetRect (&rects
[i
], right
- rects
[i
].right
,
2560 bottom
- rects
[i
].bottom
);
2561 right
= rects
[i
].left
- DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE
;
2562 if (i
== first_group_count
- 1)
2563 right
-= DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE
;
2565 buttons_height
= - (bottom
- max_height
);
2567 left_align_shift
= - (inner_width
+ rects
[nb_buttons
- 1].left
);
2568 for (i
= nb_buttons
- 1; i
>= first_group_count
; i
--)
2570 if (bottom
!= rects
[i
].bottom
)
2572 left_align_shift
= - (inner_width
+ rects
[i
].left
);
2573 bottom
= rects
[i
].bottom
;
2575 OffsetRect (&rects
[i
], left_align_shift
, 0);
2579 /* Create a static text control and measure its bounds. */
2582 CFStringRef message_string
;
2585 message_string
= cfstring_create_with_utf8_cstring (message
);
2586 if (message_string
== NULL
)
2590 ControlFontStyleRec text_style
;
2592 text_style
.flags
= 0;
2593 SetRect (&bounds
, 0, 0, inner_width
, 0);
2594 err
= CreateStaticTextControl (window
, &bounds
, message_string
,
2595 &text_style
, &text
);
2596 CFRelease (message_string
);
2602 bounds
= empty_rect
;
2603 err
= GetBestControlRect (text
, &bounds
, &unused
);
2607 text_height
= bounds
.bottom
- bounds
.top
;
2608 if (text_height
< DIALOG_TEXT_MIN_HEIGHT
)
2609 text_height
= DIALOG_TEXT_MIN_HEIGHT
;
2613 /* Place buttons. */
2616 inner_height
= (text_height
+ DIALOG_TEXT_BUTTONS_VERTICAL_SPACE
2619 for (i
= 0; i
< nb_buttons
; i
++)
2621 OffsetRect (&rects
[i
], DIALOG_LEFT_MARGIN
+ inner_width
,
2622 DIALOG_TOP_MARGIN
+ inner_height
);
2623 SetControlBounds (buttons
[i
], &rects
[i
]);
2632 SetRect (&bounds
, DIALOG_LEFT_MARGIN
, DIALOG_TOP_MARGIN
,
2633 DIALOG_LEFT_MARGIN
+ inner_width
,
2634 DIALOG_TOP_MARGIN
+ text_height
);
2635 SetControlBounds (text
, &bounds
);
2638 /* Create the application icon at the upper-left corner. */
2641 ControlButtonContentInfo content
;
2643 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
2647 ProcessInfoRec pinfo
;
2652 content
.contentType
= kControlContentIconRef
;
2654 err
= GetProcessBundleLocation (&psn
, &app_location
);
2656 err
= GetIconRefFromFileInfo (&app_location
, 0, NULL
, 0, NULL
,
2657 kIconServicesNormalUsageFlag
,
2658 &content
.u
.iconRef
, &unused
);
2660 bzero (&pinfo
, sizeof (ProcessInfoRec
));
2661 pinfo
.processInfoLength
= sizeof (ProcessInfoRec
);
2662 pinfo
.processAppSpec
= &app_spec
;
2663 err
= GetProcessInformation (&psn
, &pinfo
);
2665 err
= GetIconRefFromFile (&app_spec
, &content
.u
.iconRef
, &unused
);
2671 SetRect (&bounds
, DIALOG_ICON_LEFT_MARGIN
, DIALOG_ICON_TOP_MARGIN
,
2672 DIALOG_ICON_LEFT_MARGIN
+ DIALOG_ICON_WIDTH
,
2673 DIALOG_ICON_TOP_MARGIN
+ DIALOG_ICON_HEIGHT
);
2674 err
= CreateIconControl (window
, &bounds
, &content
, true, &icon
);
2675 ReleaseIconRef (content
.u
.iconRef
);
2679 /* Show the dialog window and run event loop. */
2682 err
= SetWindowDefaultButton (window
, default_button
);
2684 err
= install_dialog_event_handler (window
);
2688 DIALOG_LEFT_MARGIN
+ inner_width
+ DIALOG_RIGHT_MARGIN
,
2689 DIALOG_TOP_MARGIN
+ inner_height
+ DIALOG_BOTTOM_MARGIN
,
2691 err
= RepositionWindow (window
, FRAME_MAC_WINDOW (f
),
2692 kWindowAlertPositionOnParentWindow
);
2696 SetWRefCon (window
, 0);
2697 ShowWindow (window
);
2698 BringToFront (window
);
2699 err
= RunAppModalLoopForWindow (window
);
2703 UInt32 command_id
= GetWRefCon (window
);
2705 if ((command_id
& ~0xffff) == 'Bt\0\0')
2706 result
= command_id
- 'Bt\0\0';
2710 DisposeWindow (window
);
2714 #else /* not TARGET_API_MAC_CARBON */
2716 mac_dialog (widget_value
*wv
)
2720 char **button_labels
;
2727 WindowPtr window_ptr
;
2730 EventRecord event_record
;
2732 int control_part_code
;
2735 dialog_name
= wv
->name
;
2736 nb_buttons
= dialog_name
[1] - '0';
2737 left_count
= nb_buttons
- (dialog_name
[4] - '0');
2738 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
2739 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
2742 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
2743 strcpy (prompt
, wv
->value
);
2747 for (i
= 0; i
< nb_buttons
; i
++)
2749 button_labels
[i
] = wv
->value
;
2750 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
2751 strcpy (button_labels
[i
], wv
->value
);
2752 c2pstr (button_labels
[i
]);
2753 ref_cons
[i
] = (UInt32
) wv
->call_data
;
2757 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
2759 SetPortWindowPort (window_ptr
);
2762 /* Left and right margins in the dialog are 13 pixels each.*/
2764 /* Calculate width of dialog box: 8 pixels on each side of the text
2765 label in each button, 12 pixels between buttons. */
2766 for (i
= 0; i
< nb_buttons
; i
++)
2767 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
2769 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
2772 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
2774 SizeWindow (window_ptr
, dialog_width
, 78, 0);
2775 ShowWindow (window_ptr
);
2777 SetPortWindowPort (window_ptr
);
2782 DrawString (prompt
);
2785 for (i
= 0; i
< nb_buttons
; i
++)
2787 int button_width
= StringWidth (button_labels
[i
]) + 16;
2788 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
2789 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
2790 kControlPushButtonProc
, ref_cons
[i
]);
2791 left
+= button_width
+ 12;
2792 if (i
== left_count
- 1)
2799 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
2800 if (event_record
.what
== mouseDown
)
2802 part_code
= FindWindow (event_record
.where
, &window_ptr
);
2803 if (part_code
== inContent
)
2805 mouse
= event_record
.where
;
2806 GlobalToLocal (&mouse
);
2807 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2808 if (control_part_code
== kControlButtonPart
)
2809 if (TrackControl (ch
, mouse
, NULL
))
2810 i
= GetControlReference (ch
);
2815 DisposeWindow (window_ptr
);
2819 #endif /* not TARGET_API_MAC_CARBON */
2821 static char * button_names
[] = {
2822 "button1", "button2", "button3", "button4", "button5",
2823 "button6", "button7", "button8", "button9", "button10" };
2826 mac_dialog_show (f
, keymaps
, title
, header
, error_name
)
2829 Lisp_Object title
, header
;
2832 int i
, nb_buttons
=0;
2833 char dialog_name
[6];
2834 int menu_item_selection
;
2836 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2838 /* Number of elements seen so far, before boundary. */
2840 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2841 int boundary_seen
= 0;
2845 if (menu_items_n_panes
> 1)
2847 *error_name
= "Multiple panes in dialog box";
2851 /* Create a tree of widget_value objects
2852 representing the text label and buttons. */
2854 Lisp_Object pane_name
, prefix
;
2856 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2857 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2858 pane_string
= (NILP (pane_name
)
2859 ? "" : (char *) SDATA (pane_name
));
2860 prev_wv
= xmalloc_widget_value ();
2861 prev_wv
->value
= pane_string
;
2862 if (keymaps
&& !NILP (prefix
))
2864 prev_wv
->enabled
= 1;
2865 prev_wv
->name
= "message";
2866 prev_wv
->help
= Qnil
;
2869 /* Loop over all panes and items, filling in the tree. */
2870 i
= MENU_ITEMS_PANE_LENGTH
;
2871 while (i
< menu_items_used
)
2874 /* Create a new item within current pane. */
2875 Lisp_Object item_name
, enable
, descrip
;
2876 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2877 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2879 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2881 if (NILP (item_name
))
2883 free_menubar_widget_value_tree (first_wv
);
2884 *error_name
= "Submenu in dialog items";
2887 if (EQ (item_name
, Qquote
))
2889 /* This is the boundary between left-side elts
2890 and right-side elts. Stop incrementing right_count. */
2895 if (nb_buttons
>= 9)
2897 free_menubar_widget_value_tree (first_wv
);
2898 *error_name
= "Too many dialog items";
2902 wv
= xmalloc_widget_value ();
2904 wv
->name
= (char *) button_names
[nb_buttons
];
2905 if (!NILP (descrip
))
2906 wv
->key
= (char *) SDATA (descrip
);
2907 wv
->value
= (char *) SDATA (item_name
);
2908 wv
->call_data
= (void *) i
;
2909 /* menu item is identified by its index in menu_items table */
2910 wv
->enabled
= !NILP (enable
);
2914 if (! boundary_seen
)
2918 i
+= MENU_ITEMS_ITEM_LENGTH
;
2921 /* If the boundary was not specified,
2922 by default put half on the left and half on the right. */
2923 if (! boundary_seen
)
2924 left_count
= nb_buttons
- nb_buttons
/ 2;
2926 wv
= xmalloc_widget_value ();
2927 wv
->name
= dialog_name
;
2930 /* Frame title: 'Q' = Question, 'I' = Information.
2931 Can also have 'E' = Error if, one day, we want
2932 a popup for errors. */
2934 dialog_name
[0] = 'Q';
2936 dialog_name
[0] = 'I';
2938 /* Dialog boxes use a really stupid name encoding
2939 which specifies how many buttons to use
2940 and how many buttons are on the right. */
2941 dialog_name
[1] = '0' + nb_buttons
;
2942 dialog_name
[2] = 'B';
2943 dialog_name
[3] = 'R';
2944 /* Number of buttons to put on the right. */
2945 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2947 wv
->contents
= first_wv
;
2951 /* Force a redisplay before showing the dialog. If a frame is created
2952 just before showing the dialog, its contents may not have been fully
2956 /* Actually create the dialog. */
2957 #if TARGET_API_MAC_CARBON
2958 menu_item_selection
= create_and_show_dialog (f
, first_wv
);
2960 menu_item_selection
= mac_dialog (first_wv
);
2963 /* Free the widget_value objects we used to specify the contents. */
2964 free_menubar_widget_value_tree (first_wv
);
2966 /* Find the selected item, and its pane, to return
2967 the proper value. */
2968 if (menu_item_selection
!= 0)
2974 while (i
< menu_items_used
)
2978 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2981 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2982 i
+= MENU_ITEMS_PANE_LENGTH
;
2984 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2986 /* This is the boundary between left-side elts and
2993 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2994 if (menu_item_selection
== i
)
2998 entry
= Fcons (entry
, Qnil
);
3000 entry
= Fcons (prefix
, entry
);
3004 i
+= MENU_ITEMS_ITEM_LENGTH
;
3009 /* Make "Cancel" equivalent to C-g. */
3010 Fsignal (Qquit
, Qnil
);
3014 #endif /* HAVE_DIALOGS */
3017 /* Is this item a separator? */
3019 name_is_separator (name
)
3022 const char *start
= name
;
3024 /* Check if name string consists of only dashes ('-'). */
3025 while (*name
== '-') name
++;
3026 /* Separators can also be of the form "--:TripleSuperMegaEtched"
3027 or "--deep-shadow". We don't implement them yet, se we just treat
3028 them like normal separators. */
3029 return (*name
== '\0' || start
+ 2 == name
);
3033 add_menu_item (menu
, pos
, wv
)
3038 #if TARGET_API_MAC_CARBON
3039 CFStringRef item_name
;
3044 if (name_is_separator (wv
->name
))
3045 AppendMenu (menu
, "\p-");
3048 AppendMenu (menu
, "\pX");
3050 #if TARGET_API_MAC_CARBON
3051 item_name
= cfstring_create_with_utf8_cstring (wv
->name
);
3053 if (wv
->key
!= NULL
)
3055 CFStringRef name
, key
;
3058 key
= cfstring_create_with_utf8_cstring (wv
->key
);
3059 item_name
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@ %@"),
3065 SetMenuItemTextWithCFString (menu
, pos
, item_name
);
3066 CFRelease (item_name
);
3069 EnableMenuItem (menu
, pos
);
3071 DisableMenuItem (menu
, pos
);
3073 if (STRINGP (wv
->help
))
3074 SetMenuItemProperty (menu
, pos
, MAC_EMACS_CREATOR_CODE
, 'help',
3075 sizeof (Lisp_Object
), &wv
->help
);
3076 #else /* ! TARGET_API_MAC_CARBON */
3077 item_name
[sizeof (item_name
) - 1] = '\0';
3078 strncpy (item_name
, wv
->name
, sizeof (item_name
) - 1);
3079 if (wv
->key
!= NULL
)
3081 int len
= strlen (item_name
);
3083 strncpy (item_name
+ len
, " ", sizeof (item_name
) - 1 - len
);
3084 len
= strlen (item_name
);
3085 strncpy (item_name
+ len
, wv
->key
, sizeof (item_name
) - 1 - len
);
3088 SetMenuItemText (menu
, pos
, item_name
);
3091 EnableItem (menu
, pos
);
3093 DisableItem (menu
, pos
);
3094 #endif /* ! TARGET_API_MAC_CARBON */
3096 /* Draw radio buttons and tickboxes. */
3097 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
3098 wv
->button_type
== BUTTON_TYPE_RADIO
))
3099 SetItemMark (menu
, pos
, checkMark
);
3101 SetItemMark (menu
, pos
, noMark
);
3103 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
3107 /* Construct native Mac OS menu based on widget_value tree. */
3110 fill_menu (menu
, wv
, kind
, submenu_id
)
3113 enum mac_menu_kind kind
;
3118 for (pos
= 1; wv
!= NULL
; wv
= wv
->next
, pos
++)
3120 add_menu_item (menu
, pos
, wv
);
3121 if (wv
->contents
&& submenu_id
< min_menu_id
[kind
+ 1])
3123 MenuHandle submenu
= NewMenu (submenu_id
, "\pX");
3125 InsertMenu (submenu
, -1);
3126 SetMenuItemHierarchicalID (menu
, pos
, submenu_id
);
3127 submenu_id
= fill_menu (submenu
, wv
->contents
, kind
, submenu_id
+ 1);
3134 /* Construct native Mac OS menubar based on widget_value tree. */
3137 fill_menubar (wv
, deep_p
)
3144 #if !TARGET_API_MAC_CARBON
3145 int title_changed_p
= 0;
3148 /* Clean up the menu bar when filled by the entire menu trees. */
3151 dispose_menus (MAC_MENU_MENU_BAR
, 0);
3152 dispose_menus (MAC_MENU_MENU_BAR_SUB
, 0);
3153 #if !TARGET_API_MAC_CARBON
3154 title_changed_p
= 1;
3158 /* Fill menu bar titles and submenus. Reuse the existing menu bar
3159 titles as much as possible to minimize redraw (if !deep_p). */
3160 submenu_id
= min_menu_id
[MAC_MENU_MENU_BAR_SUB
];
3161 for (id
= min_menu_id
[MAC_MENU_MENU_BAR
];
3162 wv
!= NULL
&& id
< min_menu_id
[MAC_MENU_MENU_BAR
+ 1];
3163 wv
= wv
->next
, id
++)
3165 strncpy (title
, wv
->name
, 255);
3169 menu
= GetMenuHandle (id
);
3172 #if TARGET_API_MAC_CARBON
3175 GetMenuTitle (menu
, old_title
);
3176 if (!EqualString (title
, old_title
, false, false))
3177 SetMenuTitle (menu
, title
);
3178 #else /* !TARGET_API_MAC_CARBON */
3179 if (!EqualString (title
, (*menu
)->menuData
, false, false))
3183 menu
= NewMenu (id
, title
);
3184 InsertMenu (menu
, GetMenuHandle (id
+ 1) ? id
+ 1 : 0);
3185 title_changed_p
= 1;
3187 #endif /* !TARGET_API_MAC_CARBON */
3191 menu
= NewMenu (id
, title
);
3192 InsertMenu (menu
, 0);
3193 #if !TARGET_API_MAC_CARBON
3194 title_changed_p
= 1;
3199 submenu_id
= fill_menu (menu
, wv
->contents
, MAC_MENU_MENU_BAR_SUB
,
3203 if (id
< min_menu_id
[MAC_MENU_MENU_BAR
+ 1] && GetMenuHandle (id
))
3205 dispose_menus (MAC_MENU_MENU_BAR
, id
);
3206 #if !TARGET_API_MAC_CARBON
3207 title_changed_p
= 1;
3211 #if !TARGET_API_MAC_CARBON
3212 if (title_changed_p
)
3217 /* Dispose of menus that belong to KIND, and remove them from the menu
3218 list. ID is the lower bound of menu IDs that will be processed. */
3221 dispose_menus (kind
, id
)
3222 enum mac_menu_kind kind
;
3225 for (id
= max (id
, min_menu_id
[kind
]); id
< min_menu_id
[kind
+ 1]; id
++)
3227 MenuHandle menu
= GetMenuHandle (id
);
3236 #endif /* HAVE_MENUS */
3238 /* Detect if a menu is currently active. */
3243 return popup_activated_flag
;
3246 /* The following is used by delayed window autoselection. */
3248 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
3249 doc
: /* Return t if a menu or popup dialog is active. */)
3252 /* Always return Qnil since menu selection functions do not return
3253 until a selection has been made or cancelled. */
3260 staticpro (&menu_items
);
3263 Qdebug_on_next_call
= intern ("debug-on-next-call");
3264 staticpro (&Qdebug_on_next_call
);
3266 defsubr (&Sx_popup_menu
);
3267 defsubr (&Smenu_or_popup_active_p
);
3269 defsubr (&Sx_popup_dialog
);
3273 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
3274 (do not change this comment) */