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)
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 /* This is set nonzero after the user activates the menu bar, and set
263 to zero again after the menu bars are redisplayed by prepare_menu_bar.
264 While it is nonzero, all calls to set_frame_menubar go deep.
266 I don't understand why this is needed, but it does seem to be
267 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
269 int pending_menu_activation
;
271 /* Initialize the menu_items structure if we haven't already done so.
272 Also mark it as currently empty. */
277 if (NILP (menu_items
))
279 menu_items_allocated
= 60;
280 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
284 menu_items_n_panes
= 0;
285 menu_items_submenu_depth
= 0;
288 /* Call at the end of generating the data in menu_items. */
295 /* Call when finished using the data for the current menu
299 discard_menu_items ()
301 /* Free the structure if it is especially large.
302 Otherwise, hold on to it, to save time. */
303 if (menu_items_allocated
> 200)
306 menu_items_allocated
= 0;
310 /* This undoes save_menu_items, and it is called by the specpdl unwind
314 restore_menu_items (saved
)
317 menu_items
= XCAR (saved
);
318 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
319 saved
= XCDR (saved
);
320 menu_items_used
= XINT (XCAR (saved
));
321 saved
= XCDR (saved
);
322 menu_items_n_panes
= XINT (XCAR (saved
));
323 saved
= XCDR (saved
);
324 menu_items_submenu_depth
= XINT (XCAR (saved
));
328 /* Push the whole state of menu_items processing onto the specpdl.
329 It will be restored when the specpdl is unwound. */
334 Lisp_Object saved
= list4 (menu_items
,
335 make_number (menu_items_used
),
336 make_number (menu_items_n_panes
),
337 make_number (menu_items_submenu_depth
));
338 record_unwind_protect (restore_menu_items
, saved
);
342 /* Make the menu_items vector twice as large. */
348 int old_size
= menu_items_allocated
;
351 menu_items_allocated
*= 2;
353 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
354 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
355 old_size
* sizeof (Lisp_Object
));
358 /* Begin a submenu. */
361 push_submenu_start ()
363 if (menu_items_used
+ 1 > menu_items_allocated
)
366 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
367 menu_items_submenu_depth
++;
375 if (menu_items_used
+ 1 > menu_items_allocated
)
378 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
379 menu_items_submenu_depth
--;
382 /* Indicate boundary between left and right. */
385 push_left_right_boundary ()
387 if (menu_items_used
+ 1 > menu_items_allocated
)
390 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
393 /* Start a new menu pane in menu_items.
394 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
397 push_menu_pane (name
, prefix_vec
)
398 Lisp_Object name
, prefix_vec
;
400 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
403 if (menu_items_submenu_depth
== 0)
404 menu_items_n_panes
++;
405 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
406 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
407 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
410 /* Push one menu item into the current pane. NAME is the string to
411 display. ENABLE if non-nil means this item can be selected. KEY
412 is the key generated by choosing this item, or nil if this item
413 doesn't really have a definition. DEF is the definition of this
414 item. EQUIV is the textual description of the keyboard equivalent
415 for this item (or nil if none). TYPE is the type of this menu
416 item, one of nil, `toggle' or `radio'. */
419 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
420 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
422 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
425 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
426 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
427 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
428 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
429 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
430 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
431 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
432 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
435 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
436 and generate menu panes for them in menu_items.
437 If NOTREAL is nonzero,
438 don't bother really computing whether an item is enabled. */
441 keymap_panes (keymaps
, nmaps
, notreal
)
442 Lisp_Object
*keymaps
;
450 /* Loop over the given keymaps, making a pane for each map.
451 But don't make a pane that is empty--ignore that map instead.
452 P is the number of panes we have made so far. */
453 for (mapno
= 0; mapno
< nmaps
; mapno
++)
454 single_keymap_panes (keymaps
[mapno
],
455 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
457 finish_menu_items ();
460 /* Args passed between single_keymap_panes and single_menu_item. */
463 Lisp_Object pending_maps
;
464 int maxdepth
, notreal
;
467 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
470 /* This is a recursive subroutine of keymap_panes.
471 It handles one keymap, KEYMAP.
472 The other arguments are passed along
473 or point to local variables of the previous function.
474 If NOTREAL is nonzero, only check for equivalent key bindings, don't
475 evaluate expressions in menu items and don't make any menu.
477 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
480 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
482 Lisp_Object pane_name
;
490 skp
.pending_maps
= Qnil
;
491 skp
.maxdepth
= maxdepth
;
492 skp
.notreal
= notreal
;
497 push_menu_pane (pane_name
, prefix
);
499 GCPRO1 (skp
.pending_maps
);
500 map_keymap (keymap
, single_menu_item
, Qnil
, &skp
, 1);
503 /* Process now any submenus which want to be panes at this level. */
504 while (CONSP (skp
.pending_maps
))
506 Lisp_Object elt
, eltcdr
, string
;
507 elt
= XCAR (skp
.pending_maps
);
509 string
= XCAR (eltcdr
);
510 /* We no longer discard the @ from the beginning of the string here.
511 Instead, we do this in mac_menu_show. */
512 single_keymap_panes (Fcar (elt
), string
,
513 XCDR (eltcdr
), notreal
, maxdepth
- 1);
514 skp
.pending_maps
= XCDR (skp
.pending_maps
);
518 /* This is a subroutine of single_keymap_panes that handles one
520 KEY is a key in a keymap and ITEM is its binding.
521 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
523 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
524 evaluate expressions in menu items and don't make any menu.
525 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
528 single_menu_item (key
, item
, dummy
, skp_v
)
529 Lisp_Object key
, item
, dummy
;
532 Lisp_Object map
, item_string
, enabled
;
533 struct gcpro gcpro1
, gcpro2
;
535 struct skp
*skp
= skp_v
;
537 /* Parse the menu item and leave the result in item_properties. */
539 res
= parse_menu_item (item
, skp
->notreal
, 0);
542 return; /* Not a menu item. */
544 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
548 /* We don't want to make a menu, just traverse the keymaps to
549 precompute equivalent key bindings. */
551 single_keymap_panes (map
, Qnil
, key
, 1, skp
->maxdepth
- 1);
555 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
556 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
558 if (!NILP (map
) && SREF (item_string
, 0) == '@')
561 /* An enabled separate pane. Remember this to handle it later. */
562 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
567 push_menu_item (item_string
, enabled
, key
,
568 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
569 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
570 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
571 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
572 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
574 /* Display a submenu using the toolkit. */
575 if (! (NILP (map
) || NILP (enabled
)))
577 push_submenu_start ();
578 single_keymap_panes (map
, Qnil
, key
, 0, skp
->maxdepth
- 1);
583 /* Push all the panes and items of a menu described by the
584 alist-of-alists MENU.
585 This handles old-fashioned calls to x-popup-menu. */
595 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
597 Lisp_Object elt
, pane_name
, pane_data
;
599 pane_name
= Fcar (elt
);
600 CHECK_STRING (pane_name
);
601 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
602 pane_data
= Fcdr (elt
);
603 CHECK_CONS (pane_data
);
604 list_of_items (pane_data
);
607 finish_menu_items ();
610 /* Push the items in a single pane defined by the alist PANE. */
616 Lisp_Object tail
, item
, item1
;
618 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
622 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
623 Qnil
, Qnil
, Qnil
, Qnil
);
624 else if (CONSP (item
))
627 CHECK_STRING (item1
);
628 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
629 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
632 push_left_right_boundary ();
638 cleanup_popup_menu (arg
)
641 discard_menu_items ();
645 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
646 doc
: /* Pop up a deck-of-cards menu and return user's selection.
647 POSITION is a position specification. This is either a mouse button event
648 or a list ((XOFFSET YOFFSET) WINDOW)
649 where XOFFSET and YOFFSET are positions in pixels from the top left
650 corner of WINDOW. (WINDOW may be a window or a frame object.)
651 This controls the position of the top left of the menu as a whole.
652 If POSITION is t, it means to use the current mouse position.
654 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
655 The menu items come from key bindings that have a menu string as well as
656 a definition; actually, the "definition" in such a key binding looks like
657 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
658 the keymap as a top-level element.
660 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
661 Otherwise, REAL-DEFINITION should be a valid key binding definition.
663 You can also use a list of keymaps as MENU.
664 Then each keymap makes a separate pane.
666 When MENU is a keymap or a list of keymaps, the return value is the
667 list of events corresponding to the user's choice. Note that
668 `x-popup-menu' does not actually execute the command bound to that
671 Alternatively, you can specify a menu of multiple panes
672 with a list of the form (TITLE PANE1 PANE2...),
673 where each pane is a list of form (TITLE ITEM1 ITEM2...).
674 Each ITEM is normally a cons cell (STRING . VALUE);
675 but a string can appear as an item--that makes a nonselectable line
677 With this form of menu, the return value is VALUE from the chosen item.
679 If POSITION is nil, don't display the menu at all, just precalculate the
680 cached information about equivalent key sequences.
682 If the user gets rid of the menu without making a valid choice, for
683 instance by clicking the mouse away from a valid choice or by typing
684 keyboard input, then this normally results in a quit and
685 `x-popup-menu' does not return. But if POSITION is a mouse button
686 event (indicating that the user invoked the menu with the mouse) then
687 no quit occurs and `x-popup-menu' returns nil. */)
689 Lisp_Object position
, menu
;
691 Lisp_Object keymap
, tem
;
692 int xpos
= 0, ypos
= 0;
694 char *error_name
= NULL
;
695 Lisp_Object selection
;
697 Lisp_Object x
, y
, window
;
700 int specpdl_count
= SPECPDL_INDEX ();
704 if (! NILP (position
))
708 /* Decode the first argument: find the window and the coordinates. */
709 if (EQ (position
, Qt
)
710 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
711 || EQ (XCAR (position
), Qtool_bar
)
712 || EQ (XCAR (position
), Qmac_apple_event
))))
714 /* Use the mouse's current position. */
715 FRAME_PTR new_f
= SELECTED_FRAME ();
716 Lisp_Object bar_window
;
717 enum scroll_bar_part part
;
720 if (mouse_position_hook
)
721 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
722 &part
, &x
, &y
, &time
);
724 XSETFRAME (window
, new_f
);
727 window
= selected_window
;
734 tem
= Fcar (position
);
737 window
= Fcar (Fcdr (position
));
739 y
= Fcar (XCDR (tem
));
744 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
745 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
746 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
755 /* Decode where to put the menu. */
763 else if (WINDOWP (window
))
765 CHECK_LIVE_WINDOW (window
);
766 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
768 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
769 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
772 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
773 but I don't want to make one now. */
774 CHECK_WINDOW (window
);
779 XSETFRAME (Vmenu_updating_frame
, f
);
782 Vmenu_updating_frame
= Qnil
;
783 #endif /* HAVE_MENUS */
788 /* Decode the menu items from what was specified. */
790 keymap
= get_keymap (menu
, 0, 0);
793 /* We were given a keymap. Extract menu info from the keymap. */
796 /* Extract the detailed info to make one pane. */
797 keymap_panes (&menu
, 1, NILP (position
));
799 /* Search for a string appearing directly as an element of the keymap.
800 That string is the title of the menu. */
801 prompt
= Fkeymap_prompt (keymap
);
802 if (NILP (title
) && !NILP (prompt
))
805 /* Make that be the pane title of the first pane. */
806 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
807 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
811 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
813 /* We were given a list of keymaps. */
814 int nmaps
= XFASTINT (Flength (menu
));
816 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
821 /* The first keymap that has a prompt string
822 supplies the menu title. */
823 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
827 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
829 prompt
= Fkeymap_prompt (keymap
);
830 if (NILP (title
) && !NILP (prompt
))
834 /* Extract the detailed info to make one pane. */
835 keymap_panes (maps
, nmaps
, NILP (position
));
837 /* Make the title be the pane title of the first pane. */
838 if (!NILP (title
) && menu_items_n_panes
>= 0)
839 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
845 /* We were given an old-fashioned menu. */
847 CHECK_STRING (title
);
849 list_of_panes (Fcdr (menu
));
856 discard_menu_items ();
862 /* Display them in a menu. */
863 record_unwind_protect (cleanup_popup_menu
, Qnil
);
866 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
867 keymaps
, title
, &error_name
);
869 unbind_to (specpdl_count
, Qnil
);
872 #endif /* HAVE_MENUS */
874 if (error_name
) error (error_name
);
880 /* Regard ESC and C-g as Cancel even without the Cancel button. */
884 mac_dialog_modal_filter (dialog
, event
, item_hit
)
887 DialogItemIndex
*item_hit
;
891 result
= StdFilterProc (dialog
, event
, item_hit
);
893 && (event
->what
== keyDown
|| event
->what
== autoKey
)
894 && ((event
->message
& charCodeMask
) == kEscapeCharCode
895 || mac_quit_char_key_p (event
->modifiers
,
896 (event
->message
& keyCodeMask
) >> 8)))
898 *item_hit
= kStdCancelItemIndex
;
906 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
907 doc
: /* Pop up a dialog box and return user's selection.
908 POSITION specifies which frame to use.
909 This is normally a mouse button event or a window or frame.
910 If POSITION is t, it means to use the frame the mouse is on.
911 The dialog box appears in the middle of the specified frame.
913 CONTENTS specifies the alternatives to display in the dialog box.
914 It is a list of the form (DIALOG ITEM1 ITEM2...).
915 Each ITEM is a cons cell (STRING . VALUE).
916 The return value is VALUE from the chosen item.
918 An ITEM may also be just a string--that makes a nonselectable item.
919 An ITEM may also be nil--that means to put all preceding items
920 on the left of the dialog box and all following items on the right.
921 \(By default, approximately half appear on each side.)
923 If HEADER is non-nil, the frame title for the box is "Information",
924 otherwise it is "Question".
926 If the user gets rid of the dialog box without making a valid choice,
927 for instance using the window manager, then this produces a quit and
928 `x-popup-dialog' does not return. */)
929 (position
, contents
, header
)
930 Lisp_Object position
, contents
, header
;
937 /* Decode the first argument: find the window or frame to use. */
938 if (EQ (position
, Qt
)
939 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
940 || EQ (XCAR (position
), Qtool_bar
)
941 || EQ (XCAR (position
), Qmac_apple_event
))))
943 #if 0 /* Using the frame the mouse is on may not be right. */
944 /* Use the mouse's current position. */
945 FRAME_PTR new_f
= SELECTED_FRAME ();
946 Lisp_Object bar_window
;
947 enum scroll_bar_part part
;
951 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
954 XSETFRAME (window
, new_f
);
956 window
= selected_window
;
958 window
= selected_window
;
960 else if (CONSP (position
))
963 tem
= Fcar (position
);
965 window
= Fcar (Fcdr (position
));
968 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
969 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
972 else if (WINDOWP (position
) || FRAMEP (position
))
977 /* Decode where to put the menu. */
981 else if (WINDOWP (window
))
983 CHECK_LIVE_WINDOW (window
);
984 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
987 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
988 but I don't want to make one now. */
989 CHECK_WINDOW (window
);
992 /* Special treatment for Fmessage_box, Fyes_or_no_p, and Fy_or_n_p. */
993 if (EQ (position
, Qt
)
994 && STRINGP (Fcar (contents
))
995 && ((!NILP (Fequal (XCDR (contents
),
996 Fcons (Fcons (build_string ("OK"), Qt
), Qnil
)))
998 || (!NILP (Fequal (XCDR (contents
),
999 Fcons (Fcons (build_string ("Yes"), Qt
),
1000 Fcons (Fcons (build_string ("No"), Qnil
),
1004 OSStatus err
= noErr
;
1005 AlertStdCFStringAlertParamRec param
;
1006 CFStringRef error_string
, explanation_string
;
1008 DialogItemIndex item_hit
;
1011 tem
= Fstring_match (concat3 (build_string ("\\("),
1012 call0 (intern ("sentence-end")),
1013 build_string ("\\)\n")),
1014 XCAR (contents
), Qnil
);
1018 error_string
= cfstring_create_with_string (XCAR (contents
));
1019 if (error_string
== NULL
)
1021 explanation_string
= NULL
;
1025 tem
= Fmatch_end (make_number (1));
1027 cfstring_create_with_string (Fsubstring (XCAR (contents
),
1028 make_number (0), tem
));
1029 if (error_string
== NULL
)
1033 XSETINT (tem
, XINT (tem
) + 1);
1034 explanation_string
=
1035 cfstring_create_with_string (Fsubstring (XCAR (contents
),
1037 if (explanation_string
== NULL
)
1039 CFRelease (error_string
);
1045 err
= GetStandardAlertDefaultParams (¶m
,
1046 kStdCFStringAlertVersionOne
);
1049 param
.movable
= true;
1050 param
.position
= kWindowAlertPositionParentWindow
;
1053 param
.defaultText
= CFSTR ("Yes");
1054 param
.otherText
= CFSTR ("No");
1056 param
.cancelText
= CFSTR ("Cancel");
1057 param
.cancelButton
= kAlertStdAlertCancelButton
;
1060 err
= CreateStandardAlert (kAlertNoteAlert
, error_string
,
1061 explanation_string
, ¶m
, &alert
);
1062 CFRelease (error_string
);
1063 if (explanation_string
)
1064 CFRelease (explanation_string
);
1067 err
= RunStandardAlert (alert
, mac_dialog_modal_filter
, &item_hit
);
1072 if (item_hit
== kStdCancelItemIndex
)
1073 Fsignal (Qquit
, Qnil
);
1074 else if (item_hit
== kStdOkItemIndex
)
1081 #ifndef HAVE_DIALOGS
1082 /* Display a menu with these alternatives
1083 in the middle of frame F. */
1085 Lisp_Object x
, y
, frame
, newpos
;
1086 XSETFRAME (frame
, f
);
1087 XSETINT (x
, x_pixel_width (f
) / 2);
1088 XSETINT (y
, x_pixel_height (f
) / 2);
1089 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
1091 return Fx_popup_menu (newpos
,
1092 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
1094 #else /* HAVE_DIALOGS */
1098 Lisp_Object selection
;
1099 int specpdl_count
= SPECPDL_INDEX ();
1101 /* Decode the dialog items from what was specified. */
1102 title
= Fcar (contents
);
1103 CHECK_STRING (title
);
1105 list_of_panes (Fcons (contents
, Qnil
));
1107 /* Display them in a dialog box. */
1108 record_unwind_protect (cleanup_popup_menu
, Qnil
);
1110 selection
= mac_dialog_show (f
, 0, title
, header
, &error_name
);
1112 unbind_to (specpdl_count
, Qnil
);
1114 if (error_name
) error (error_name
);
1117 #endif /* HAVE_DIALOGS */
1120 /* Activate the menu bar of frame F.
1121 This is called from keyboard.c when it gets the
1122 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1124 To activate the menu bar, we use the button-press event location
1125 that was saved in saved_menu_event_location.
1127 But first we recompute the menu bar contents (the whole tree).
1129 The reason for saving the button event until here, instead of
1130 passing it to the toolkit right away, is that we can safely
1131 execute Lisp code. */
1134 x_activate_menubar (f
)
1138 SInt16 menu_id
, menu_item
;
1139 extern Point saved_menu_event_location
;
1141 set_frame_menubar (f
, 0, 1);
1144 menu_choice
= MenuSelect (saved_menu_event_location
);
1145 menu_id
= HiWord (menu_choice
);
1146 menu_item
= LoWord (menu_choice
);
1148 #if !TARGET_API_MAC_CARBON
1149 if (menu_id
== min_menu_id
[MAC_MENU_M_APPLE
])
1150 do_apple_menu (menu_item
);
1155 MenuHandle menu
= GetMenuHandle (menu_id
);
1161 GetMenuItemRefCon (menu
, menu_item
, &refcon
);
1162 find_and_call_menu_selection (f
, f
->menu_bar_items_used
,
1163 f
->menu_bar_vector
, (void *) refcon
);
1172 /* Find the menu selection and store it in the keyboard buffer.
1173 F is the frame the menu is on.
1174 MENU_BAR_ITEMS_USED is the length of VECTOR.
1175 VECTOR is an array of menu events for the whole menu. */
1178 find_and_call_menu_selection (f
, menu_bar_items_used
, vector
, client_data
)
1180 int menu_bar_items_used
;
1184 Lisp_Object prefix
, entry
;
1185 Lisp_Object
*subprefix_stack
;
1186 int submenu_depth
= 0;
1190 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
1194 while (i
< menu_bar_items_used
)
1196 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1198 subprefix_stack
[submenu_depth
++] = prefix
;
1202 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1204 prefix
= subprefix_stack
[--submenu_depth
];
1207 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1209 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1210 i
+= MENU_ITEMS_PANE_LENGTH
;
1214 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1215 /* The EMACS_INT cast avoids a warning. There's no problem
1216 as long as pointers have enough bits to hold small integers. */
1217 if ((int) (EMACS_INT
) client_data
== i
)
1220 struct input_event buf
;
1224 XSETFRAME (frame
, f
);
1225 buf
.kind
= MENU_BAR_EVENT
;
1226 buf
.frame_or_window
= frame
;
1228 kbd_buffer_store_event (&buf
);
1230 for (j
= 0; j
< submenu_depth
; j
++)
1231 if (!NILP (subprefix_stack
[j
]))
1233 buf
.kind
= MENU_BAR_EVENT
;
1234 buf
.frame_or_window
= frame
;
1235 buf
.arg
= subprefix_stack
[j
];
1236 kbd_buffer_store_event (&buf
);
1241 buf
.kind
= MENU_BAR_EVENT
;
1242 buf
.frame_or_window
= frame
;
1244 kbd_buffer_store_event (&buf
);
1247 buf
.kind
= MENU_BAR_EVENT
;
1248 buf
.frame_or_window
= frame
;
1250 kbd_buffer_store_event (&buf
);
1254 i
+= MENU_ITEMS_ITEM_LENGTH
;
1259 /* Allocate a widget_value, blocking input. */
1262 xmalloc_widget_value ()
1264 widget_value
*value
;
1267 value
= malloc_widget_value ();
1273 /* This recursively calls free_widget_value on the tree of widgets.
1274 It must free all data that was malloc'ed for these widget_values.
1275 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1276 must be left alone. */
1279 free_menubar_widget_value_tree (wv
)
1284 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1286 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1288 free_menubar_widget_value_tree (wv
->contents
);
1289 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1293 free_menubar_widget_value_tree (wv
->next
);
1294 wv
->next
= (widget_value
*) 0xDEADBEEF;
1297 free_widget_value (wv
);
1301 /* Set up data in menu_items for a menu bar item
1302 whose event type is ITEM_KEY (with string ITEM_NAME)
1303 and whose contents come from the list of keymaps MAPS. */
1306 parse_single_submenu (item_key
, item_name
, maps
)
1307 Lisp_Object item_key
, item_name
, maps
;
1311 Lisp_Object
*mapvec
;
1313 int top_level_items
= 0;
1315 length
= Flength (maps
);
1316 len
= XINT (length
);
1318 /* Convert the list MAPS into a vector MAPVEC. */
1319 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1320 for (i
= 0; i
< len
; i
++)
1322 mapvec
[i
] = Fcar (maps
);
1326 /* Loop over the given keymaps, making a pane for each map.
1327 But don't make a pane that is empty--ignore that map instead. */
1328 for (i
= 0; i
< len
; i
++)
1330 if (!KEYMAPP (mapvec
[i
]))
1332 /* Here we have a command at top level in the menu bar
1333 as opposed to a submenu. */
1334 top_level_items
= 1;
1335 push_menu_pane (Qnil
, Qnil
);
1336 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1337 Qnil
, Qnil
, Qnil
, Qnil
);
1342 prompt
= Fkeymap_prompt (mapvec
[i
]);
1343 single_keymap_panes (mapvec
[i
],
1344 !NILP (prompt
) ? prompt
: item_name
,
1349 return top_level_items
;
1352 /* Create a tree of widget_value objects
1353 representing the panes and items
1354 in menu_items starting at index START, up to index END. */
1356 static widget_value
*
1357 digest_single_submenu (start
, end
, top_level_items
)
1358 int start
, end
, top_level_items
;
1360 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1362 int submenu_depth
= 0;
1363 widget_value
**submenu_stack
;
1367 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1368 wv
= xmalloc_widget_value ();
1372 wv
->button_type
= BUTTON_TYPE_NONE
;
1378 /* Loop over all panes and items made by the preceding call
1379 to parse_single_submenu and construct a tree of widget_value objects.
1380 Ignore the panes and items used by previous calls to
1381 digest_single_submenu, even though those are also in menu_items. */
1385 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1387 submenu_stack
[submenu_depth
++] = save_wv
;
1392 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1395 save_wv
= submenu_stack
[--submenu_depth
];
1398 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1399 && submenu_depth
!= 0)
1400 i
+= MENU_ITEMS_PANE_LENGTH
;
1401 /* Ignore a nil in the item list.
1402 It's meaningful only for dialog boxes. */
1403 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1405 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1407 /* Create a new pane. */
1408 Lisp_Object pane_name
, prefix
;
1413 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1414 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1416 #ifndef HAVE_MULTILINGUAL_MENU
1417 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1419 pane_name
= ENCODE_MENU_STRING (pane_name
);
1420 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1423 pane_string
= (NILP (pane_name
)
1424 ? "" : (char *) SDATA (pane_name
));
1425 /* If there is just one top-level pane, put all its items directly
1426 under the top-level menu. */
1427 if (menu_items_n_panes
== 1)
1430 /* If the pane has a meaningful name,
1431 make the pane a top-level menu item
1432 with its items as a submenu beneath it. */
1433 if (strcmp (pane_string
, ""))
1435 wv
= xmalloc_widget_value ();
1439 first_wv
->contents
= wv
;
1440 wv
->lname
= pane_name
;
1441 /* Set value to 1 so update_submenu_strings can handle '@' */
1442 wv
->value
= (char *)1;
1444 wv
->button_type
= BUTTON_TYPE_NONE
;
1452 i
+= MENU_ITEMS_PANE_LENGTH
;
1456 /* Create a new item within current pane. */
1457 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1460 /* All items should be contained in panes. */
1461 if (panes_seen
== 0)
1464 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1465 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1466 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1467 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1468 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1469 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1470 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1472 #ifndef HAVE_MULTILINGUAL_MENU
1473 if (STRING_MULTIBYTE (item_name
))
1475 item_name
= ENCODE_MENU_STRING (item_name
);
1476 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1479 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1481 descrip
= ENCODE_MENU_STRING (descrip
);
1482 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1484 #endif /* not HAVE_MULTILINGUAL_MENU */
1486 wv
= xmalloc_widget_value ();
1490 save_wv
->contents
= wv
;
1492 wv
->lname
= item_name
;
1493 if (!NILP (descrip
))
1496 /* The EMACS_INT cast avoids a warning. There's no problem
1497 as long as pointers have enough bits to hold small integers. */
1498 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1499 wv
->enabled
= !NILP (enable
);
1502 wv
->button_type
= BUTTON_TYPE_NONE
;
1503 else if (EQ (type
, QCradio
))
1504 wv
->button_type
= BUTTON_TYPE_RADIO
;
1505 else if (EQ (type
, QCtoggle
))
1506 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1510 wv
->selected
= !NILP (selected
);
1511 if (! STRINGP (help
))
1518 i
+= MENU_ITEMS_ITEM_LENGTH
;
1522 /* If we have just one "menu item"
1523 that was originally a button, return it by itself. */
1524 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1526 wv
= first_wv
->contents
;
1527 free_widget_value (first_wv
);
1534 /* Walk through the widget_value tree starting at FIRST_WV and update
1535 the char * pointers from the corresponding lisp values.
1536 We do this after building the whole tree, since GC may happen while the
1537 tree is constructed, and small strings are relocated. So we must wait
1538 until no GC can happen before storing pointers into lisp values. */
1540 update_submenu_strings (first_wv
)
1541 widget_value
*first_wv
;
1545 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1547 if (STRINGP (wv
->lname
))
1549 wv
->name
= SDATA (wv
->lname
);
1551 /* Ignore the @ that means "separate pane".
1552 This is a kludge, but this isn't worth more time. */
1553 if (wv
->value
== (char *)1)
1555 if (wv
->name
[0] == '@')
1561 if (STRINGP (wv
->lkey
))
1562 wv
->key
= SDATA (wv
->lkey
);
1565 update_submenu_strings (wv
->contents
);
1570 #if TARGET_API_MAC_CARBON
1571 extern Lisp_Object Vshow_help_function
;
1574 restore_show_help_function (old_show_help_function
)
1575 Lisp_Object old_show_help_function
;
1577 Vshow_help_function
= old_show_help_function
;
1582 static pascal OSStatus
1583 menu_target_item_handler (next_handler
, event
, data
)
1584 EventHandlerCallRef next_handler
;
1588 OSStatus err
, result
;
1590 MenuItemIndex menu_item
;
1593 int specpdl_count
= SPECPDL_INDEX ();
1595 result
= CallNextEventHandler (next_handler
, event
);
1597 err
= GetEventParameter (event
, kEventParamDirectObject
, typeMenuRef
,
1598 NULL
, sizeof (MenuRef
), NULL
, &menu
);
1600 err
= GetEventParameter (event
, kEventParamMenuItemIndex
,
1601 typeMenuItemIndex
, NULL
,
1602 sizeof (MenuItemIndex
), NULL
, &menu_item
);
1604 err
= GetMenuItemProperty (menu
, menu_item
,
1605 MAC_EMACS_CREATOR_CODE
, 'help',
1606 sizeof (Lisp_Object
), NULL
, &help
);
1610 /* Temporarily bind Vshow_help_function to Qnil because we don't
1611 want tooltips during menu tracking. */
1612 record_unwind_protect (restore_show_help_function
, Vshow_help_function
);
1613 Vshow_help_function
= Qnil
;
1615 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1617 unbind_to (specpdl_count
, Qnil
);
1619 return err
== noErr
? noErr
: result
;
1624 install_menu_target_item_handler (window
)
1627 OSStatus err
= noErr
;
1628 #if TARGET_API_MAC_CARBON
1629 static const EventTypeSpec specs
[] =
1630 {{kEventClassMenu
, kEventMenuTargetItem
}};
1631 static EventHandlerUPP menu_target_item_handlerUPP
= NULL
;
1633 if (menu_target_item_handlerUPP
== NULL
)
1634 menu_target_item_handlerUPP
=
1635 NewEventHandlerUPP (menu_target_item_handler
);
1637 err
= InstallWindowEventHandler (window
, menu_target_item_handlerUPP
,
1638 GetEventTypeCount (specs
), specs
,
1644 /* Event handler function that pops down a menu on C-g. We can only pop
1645 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1647 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1648 static pascal OSStatus
1649 menu_quit_handler (nextHandler
, theEvent
, userData
)
1650 EventHandlerCallRef nextHandler
;
1656 UInt32 keyModifiers
;
1658 err
= GetEventParameter (theEvent
, kEventParamKeyCode
,
1659 typeUInt32
, NULL
, sizeof(UInt32
), NULL
, &keyCode
);
1662 err
= GetEventParameter (theEvent
, kEventParamKeyModifiers
,
1663 typeUInt32
, NULL
, sizeof(UInt32
),
1664 NULL
, &keyModifiers
);
1666 if (err
== noErr
&& mac_quit_char_key_p (keyModifiers
, keyCode
))
1668 MenuRef menu
= userData
!= 0
1669 ? (MenuRef
)userData
: AcquireRootMenu ();
1671 CancelMenuTracking (menu
, true, 0);
1672 if (!userData
) ReleaseMenu (menu
);
1676 return CallNextEventHandler (nextHandler
, theEvent
);
1678 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1680 /* Add event handler to all menus that belong to KIND so we can detect C-g.
1681 MENU_HANDLE is the root menu of the tracking session to dismiss
1682 when C-g is detected. NULL means the menu bar.
1683 If CancelMenuTracking isn't available, do nothing. */
1686 install_menu_quit_handler (kind
, menu_handle
)
1687 enum mac_menu_kind kind
;
1688 MenuHandle menu_handle
;
1690 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1691 static const EventTypeSpec typesList
[] =
1692 {{kEventClassKeyboard
, kEventRawKeyDown
}};
1695 #if MAC_OS_X_VERSION_MIN_REQUIRED == 1020
1696 if (CancelMenuTracking
== NULL
)
1699 for (id
= min_menu_id
[kind
]; id
< min_menu_id
[kind
+ 1]; id
++)
1701 MenuHandle menu
= GetMenuHandle (id
);
1705 InstallMenuEventHandler (menu
, menu_quit_handler
,
1706 GetEventTypeCount (typesList
),
1707 typesList
, menu_handle
, NULL
);
1709 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1712 /* Set the contents of the menubar widgets of frame F.
1713 The argument FIRST_TIME is currently ignored;
1714 it is set the first time this is called, from initialize_frame_menubar. */
1717 set_frame_menubar (f
, first_time
, deep_p
)
1722 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1724 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1726 int *submenu_start
, *submenu_end
;
1727 int *submenu_top_level_items
, *submenu_n_panes
;
1729 XSETFRAME (Vmenu_updating_frame
, f
);
1731 if (! menubar_widget
)
1733 else if (pending_menu_activation
&& !deep_p
)
1738 /* Make a widget-value tree representing the entire menu trees. */
1740 struct buffer
*prev
= current_buffer
;
1742 int specpdl_count
= SPECPDL_INDEX ();
1743 int previous_menu_items_used
= f
->menu_bar_items_used
;
1744 Lisp_Object
*previous_items
1745 = (Lisp_Object
*) alloca (previous_menu_items_used
1746 * sizeof (Lisp_Object
));
1748 /* If we are making a new widget, its contents are empty,
1749 do always reinitialize them. */
1750 if (! menubar_widget
)
1751 previous_menu_items_used
= 0;
1753 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1754 specbind (Qinhibit_quit
, Qt
);
1755 /* Don't let the debugger step into this code
1756 because it is not reentrant. */
1757 specbind (Qdebug_on_next_call
, Qnil
);
1759 record_unwind_save_match_data ();
1760 if (NILP (Voverriding_local_map_menu_flag
))
1762 specbind (Qoverriding_terminal_local_map
, Qnil
);
1763 specbind (Qoverriding_local_map
, Qnil
);
1766 set_buffer_internal_1 (XBUFFER (buffer
));
1768 /* Run the Lucid hook. */
1769 safe_run_hooks (Qactivate_menubar_hook
);
1771 /* If it has changed current-menubar from previous value,
1772 really recompute the menubar from the value. */
1773 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1774 call0 (Qrecompute_lucid_menubar
);
1775 safe_run_hooks (Qmenu_bar_update_hook
);
1776 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1778 items
= FRAME_MENU_BAR_ITEMS (f
);
1780 /* Save the frame's previous menu bar contents data. */
1781 if (previous_menu_items_used
)
1782 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1783 previous_menu_items_used
* sizeof (Lisp_Object
));
1785 /* Fill in menu_items with the current menu bar contents.
1786 This can evaluate Lisp code. */
1789 menu_items
= f
->menu_bar_vector
;
1790 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1791 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1792 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1793 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1794 submenu_top_level_items
1795 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1797 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1799 Lisp_Object key
, string
, maps
;
1803 key
= XVECTOR (items
)->contents
[i
];
1804 string
= XVECTOR (items
)->contents
[i
+ 1];
1805 maps
= XVECTOR (items
)->contents
[i
+ 2];
1809 submenu_start
[i
] = menu_items_used
;
1811 menu_items_n_panes
= 0;
1812 submenu_top_level_items
[i
]
1813 = parse_single_submenu (key
, string
, maps
);
1814 submenu_n_panes
[i
] = menu_items_n_panes
;
1816 submenu_end
[i
] = menu_items_used
;
1819 finish_menu_items ();
1821 /* Convert menu_items into widget_value trees
1822 to display the menu. This cannot evaluate Lisp code. */
1824 wv
= xmalloc_widget_value ();
1825 wv
->name
= "menubar";
1828 wv
->button_type
= BUTTON_TYPE_NONE
;
1832 for (i
= 0; i
< last_i
; i
+= 4)
1834 menu_items_n_panes
= submenu_n_panes
[i
];
1835 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1836 submenu_top_level_items
[i
]);
1840 first_wv
->contents
= wv
;
1841 /* Don't set wv->name here; GC during the loop might relocate it. */
1843 wv
->button_type
= BUTTON_TYPE_NONE
;
1847 set_buffer_internal_1 (prev
);
1849 /* If there has been no change in the Lisp-level contents
1850 of the menu bar, skip redisplaying it. Just exit. */
1852 /* Compare the new menu items with the ones computed last time. */
1853 for (i
= 0; i
< previous_menu_items_used
; i
++)
1854 if (menu_items_used
== i
1855 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1857 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1859 /* The menu items have not changed. Don't bother updating
1860 the menus in any form, since it would be a no-op. */
1861 free_menubar_widget_value_tree (first_wv
);
1862 discard_menu_items ();
1863 unbind_to (specpdl_count
, Qnil
);
1867 /* The menu items are different, so store them in the frame. */
1868 f
->menu_bar_vector
= menu_items
;
1869 f
->menu_bar_items_used
= menu_items_used
;
1871 /* This calls restore_menu_items to restore menu_items, etc.,
1872 as they were outside. */
1873 unbind_to (specpdl_count
, Qnil
);
1875 /* Now GC cannot happen during the lifetime of the widget_value,
1876 so it's safe to store data from a Lisp_String. */
1877 wv
= first_wv
->contents
;
1878 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1881 string
= XVECTOR (items
)->contents
[i
+ 1];
1884 wv
->name
= (char *) SDATA (string
);
1885 update_submenu_strings (wv
->contents
);
1892 /* Make a widget-value tree containing
1893 just the top level menu bar strings. */
1895 wv
= xmalloc_widget_value ();
1896 wv
->name
= "menubar";
1899 wv
->button_type
= BUTTON_TYPE_NONE
;
1903 items
= FRAME_MENU_BAR_ITEMS (f
);
1904 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1908 string
= XVECTOR (items
)->contents
[i
+ 1];
1912 wv
= xmalloc_widget_value ();
1913 wv
->name
= (char *) SDATA (string
);
1916 wv
->button_type
= BUTTON_TYPE_NONE
;
1918 /* This prevents lwlib from assuming this
1919 menu item is really supposed to be empty. */
1920 /* The EMACS_INT cast avoids a warning.
1921 This value just has to be different from small integers. */
1922 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1927 first_wv
->contents
= wv
;
1931 /* Forget what we thought we knew about what is in the
1932 detailed contents of the menu bar menus.
1933 Changing the top level always destroys the contents. */
1934 f
->menu_bar_items_used
= 0;
1937 /* Create or update the menu bar widget. */
1941 /* Non-null value to indicate menubar has already been "created". */
1942 f
->output_data
.mac
->menubar_widget
= 1;
1944 fill_menubar (first_wv
->contents
, deep_p
);
1946 /* Add event handler so we can detect C-g. */
1947 install_menu_quit_handler (MAC_MENU_MENU_BAR
, NULL
);
1948 install_menu_quit_handler (MAC_MENU_MENU_BAR_SUB
, NULL
);
1949 free_menubar_widget_value_tree (first_wv
);
1954 /* Get rid of the menu bar of frame F, and free its storage.
1955 This is used when deleting a frame, and when turning off the menu bar. */
1958 free_frame_menubar (f
)
1961 f
->output_data
.mac
->menubar_widget
= 0;
1969 struct Lisp_Save_Value
*p
= XSAVE_VALUE (arg
);
1970 FRAME_PTR f
= p
->pointer
;
1971 MenuHandle menu
= GetMenuHandle (min_menu_id
[MAC_MENU_POPUP
]);
1975 /* Must reset this manually because the button release event is not
1976 passed to Emacs event loop. */
1977 FRAME_MAC_DISPLAY_INFO (f
)->grabbed
= 0;
1979 /* delete all menus */
1980 dispose_menus (MAC_MENU_POPUP_SUB
, 0);
1981 DeleteMenu (min_menu_id
[MAC_MENU_POPUP
]);
1989 /* Mac_menu_show actually displays a menu using the panes and items in
1990 menu_items and returns the value selected from it; we assume input
1991 is blocked by the caller. */
1993 /* F is the frame the menu is for.
1994 X and Y are the frame-relative specified position,
1995 relative to the inside upper left corner of the frame F.
1996 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1997 KEYMAPS is 1 if this menu was specified with keymaps;
1998 in that case, we return a list containing the chosen item's value
1999 and perhaps also the pane's prefix.
2000 TITLE is the specified menu title.
2001 ERROR is a place to store an error message string in case of failure.
2002 (We return nil on failure, but the value doesn't actually matter.) */
2005 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2016 int menu_item_choice
;
2017 int menu_item_selection
;
2020 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2021 widget_value
**submenu_stack
2022 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
2023 Lisp_Object
*subprefix_stack
2024 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
2025 int submenu_depth
= 0;
2028 int specpdl_count
= SPECPDL_INDEX ();
2032 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2034 *error
= "Empty menu";
2038 /* Create a tree of widget_value objects
2039 representing the panes and their items. */
2040 wv
= xmalloc_widget_value ();
2044 wv
->button_type
= BUTTON_TYPE_NONE
;
2049 /* Loop over all panes and items, filling in the tree. */
2051 while (i
< menu_items_used
)
2053 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2055 submenu_stack
[submenu_depth
++] = save_wv
;
2061 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2064 save_wv
= submenu_stack
[--submenu_depth
];
2068 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2069 && submenu_depth
!= 0)
2070 i
+= MENU_ITEMS_PANE_LENGTH
;
2071 /* Ignore a nil in the item list.
2072 It's meaningful only for dialog boxes. */
2073 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2075 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2077 /* Create a new pane. */
2078 Lisp_Object pane_name
, prefix
;
2081 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2082 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2084 #ifndef HAVE_MULTILINGUAL_MENU
2085 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2087 pane_name
= ENCODE_MENU_STRING (pane_name
);
2088 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2091 pane_string
= (NILP (pane_name
)
2092 ? "" : (char *) SDATA (pane_name
));
2093 /* If there is just one top-level pane, put all its items directly
2094 under the top-level menu. */
2095 if (menu_items_n_panes
== 1)
2098 /* If the pane has a meaningful name,
2099 make the pane a top-level menu item
2100 with its items as a submenu beneath it. */
2101 if (!keymaps
&& strcmp (pane_string
, ""))
2103 wv
= xmalloc_widget_value ();
2107 first_wv
->contents
= wv
;
2108 wv
->name
= pane_string
;
2109 if (keymaps
&& !NILP (prefix
))
2113 wv
->button_type
= BUTTON_TYPE_NONE
;
2118 else if (first_pane
)
2124 i
+= MENU_ITEMS_PANE_LENGTH
;
2128 /* Create a new item within current pane. */
2129 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2130 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2131 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2132 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2133 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2134 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2135 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2136 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2138 #ifndef HAVE_MULTILINGUAL_MENU
2139 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2141 item_name
= ENCODE_MENU_STRING (item_name
);
2142 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2145 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2147 descrip
= ENCODE_MENU_STRING (descrip
);
2148 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2150 #endif /* not HAVE_MULTILINGUAL_MENU */
2152 wv
= xmalloc_widget_value ();
2156 save_wv
->contents
= wv
;
2157 wv
->name
= (char *) SDATA (item_name
);
2158 if (!NILP (descrip
))
2159 wv
->key
= (char *) SDATA (descrip
);
2161 /* Use the contents index as call_data, since we are
2162 restricted to 16-bits. */
2163 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
2164 wv
->enabled
= !NILP (enable
);
2167 wv
->button_type
= BUTTON_TYPE_NONE
;
2168 else if (EQ (type
, QCtoggle
))
2169 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2170 else if (EQ (type
, QCradio
))
2171 wv
->button_type
= BUTTON_TYPE_RADIO
;
2175 wv
->selected
= !NILP (selected
);
2177 if (! STRINGP (help
))
2184 i
+= MENU_ITEMS_ITEM_LENGTH
;
2188 /* Deal with the title, if it is non-nil. */
2191 widget_value
*wv_title
= xmalloc_widget_value ();
2192 widget_value
*wv_sep
= xmalloc_widget_value ();
2194 /* Maybe replace this separator with a bitmap or owner-draw item
2195 so that it looks better. Having two separators looks odd. */
2196 wv_sep
->name
= "--";
2197 wv_sep
->next
= first_wv
->contents
;
2198 wv_sep
->help
= Qnil
;
2200 #ifndef HAVE_MULTILINGUAL_MENU
2201 if (STRING_MULTIBYTE (title
))
2202 title
= ENCODE_MENU_STRING (title
);
2205 wv_title
->name
= (char *) SDATA (title
);
2206 wv_title
->enabled
= FALSE
;
2207 wv_title
->title
= TRUE
;
2208 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2209 wv_title
->help
= Qnil
;
2210 wv_title
->next
= wv_sep
;
2211 first_wv
->contents
= wv_title
;
2214 /* Actually create the menu. */
2215 menu
= NewMenu (min_menu_id
[MAC_MENU_POPUP
], "\p");
2216 InsertMenu (menu
, -1);
2217 fill_menu (menu
, first_wv
->contents
, MAC_MENU_POPUP_SUB
,
2218 min_menu_id
[MAC_MENU_POPUP_SUB
]);
2220 /* Free the widget_value objects we used to specify the
2222 free_menubar_widget_value_tree (first_wv
);
2224 /* Adjust coordinates to be root-window-relative. */
2228 SetPortWindowPort (FRAME_MAC_WINDOW (f
));
2229 LocalToGlobal (&pos
);
2231 /* No selection has been chosen yet. */
2232 menu_item_choice
= 0;
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 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
2243 menu_item_selection
= LoWord (menu_item_choice
);
2245 /* Get the refcon to find the correct item */
2246 if (menu_item_selection
)
2248 MenuHandle sel_menu
= GetMenuHandle (HiWord (menu_item_choice
));
2250 GetMenuItemRefCon (sel_menu
, menu_item_selection
, &refcon
);
2253 else if (! for_click
)
2254 /* Make "Cancel" equivalent to C-g unless this menu was popped up by
2256 Fsignal (Qquit
, 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
;
2266 while (i
< menu_items_used
)
2268 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2270 subprefix_stack
[submenu_depth
++] = prefix
;
2274 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2276 prefix
= subprefix_stack
[--submenu_depth
];
2279 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
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
))
2292 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2293 if ((int) (EMACS_INT
) refcon
== i
)
2299 entry
= Fcons (entry
, Qnil
);
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
);
2308 i
+= MENU_ITEMS_ITEM_LENGTH
;
2312 else if (!for_click
)
2313 /* Make "Cancel" equivalent to C-g. */
2314 Fsignal (Qquit
, Qnil
);
2316 unbind_to (specpdl_count
, Qnil
);
2323 /* Construct native Mac OS dialog based on widget_value tree. */
2325 #if TARGET_API_MAC_CARBON
2327 static pascal OSStatus
2328 mac_handle_dialog_event (next_handler
, event
, data
)
2329 EventHandlerCallRef next_handler
;
2334 WindowRef window
= (WindowRef
) data
;
2336 switch (GetEventClass (event
))
2338 case kEventClassCommand
:
2342 err
= GetEventParameter (event
, kEventParamDirectObject
,
2343 typeHICommand
, NULL
, sizeof (HICommand
),
2346 if ((command
.commandID
& ~0xffff) == 'Bt\0\0')
2348 SetWRefCon (window
, command
.commandID
);
2349 err
= QuitAppModalLoopForWindow (window
);
2351 return err
== noErr
? noErr
: eventNotHandledErr
;
2354 return CallNextEventHandler (next_handler
, event
);
2358 case kEventClassKeyboard
:
2363 result
= CallNextEventHandler (next_handler
, event
);
2364 if (result
== noErr
)
2367 err
= GetEventParameter (event
, kEventParamKeyMacCharCodes
,
2368 typeChar
, NULL
, sizeof (char),
2373 case kEscapeCharCode
:
2374 err
= QuitAppModalLoopForWindow (window
);
2379 UInt32 modifiers
, key_code
;
2381 err
= GetEventParameter (event
, kEventParamKeyModifiers
,
2382 typeUInt32
, NULL
, sizeof (UInt32
),
2385 err
= GetEventParameter (event
, kEventParamKeyCode
,
2386 typeUInt32
, NULL
, sizeof (UInt32
),
2389 if (mac_quit_char_key_p (modifiers
, key_code
))
2390 err
= QuitAppModalLoopForWindow (window
);
2392 err
= eventNotHandledErr
;
2397 return err
== noErr
? noErr
: result
;
2407 install_dialog_event_handler (window
)
2410 static const EventTypeSpec specs
[] =
2411 {{kEventClassCommand
, kEventCommandProcess
},
2412 {kEventClassKeyboard
, kEventRawKeyDown
}};
2413 static EventHandlerUPP handle_dialog_eventUPP
= NULL
;
2415 if (handle_dialog_eventUPP
== NULL
)
2416 handle_dialog_eventUPP
= NewEventHandlerUPP (mac_handle_dialog_event
);
2417 return InstallWindowEventHandler (window
, handle_dialog_eventUPP
,
2418 GetEventTypeCount (specs
), specs
,
2422 #define DIALOG_LEFT_MARGIN (112)
2423 #define DIALOG_TOP_MARGIN (24)
2424 #define DIALOG_RIGHT_MARGIN (24)
2425 #define DIALOG_BOTTOM_MARGIN (20)
2426 #define DIALOG_MIN_INNER_WIDTH (338)
2427 #define DIALOG_MAX_INNER_WIDTH (564)
2428 #define DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE (12)
2429 #define DIALOG_BUTTON_BUTTON_VERTICAL_SPACE (12)
2430 #define DIALOG_BUTTON_MIN_WIDTH (68)
2431 #define DIALOG_TEXT_MIN_HEIGHT (50)
2432 #define DIALOG_TEXT_BUTTONS_VERTICAL_SPACE (10)
2433 #define DIALOG_ICON_WIDTH (64)
2434 #define DIALOG_ICON_HEIGHT (64)
2435 #define DIALOG_ICON_LEFT_MARGIN (24)
2436 #define DIALOG_ICON_TOP_MARGIN (15)
2439 create_and_show_dialog (f
, first_wv
)
2441 widget_value
*first_wv
;
2444 char *dialog_name
, *message
;
2445 int nb_buttons
, first_group_count
, i
, result
= 0;
2447 short buttons_height
, text_height
, inner_width
, inner_height
;
2448 Rect empty_rect
, *rects
;
2449 WindowRef window
= NULL
;
2450 ControlRef
*buttons
, default_button
= NULL
, text
;
2452 dialog_name
= first_wv
->name
;
2453 nb_buttons
= dialog_name
[1] - '0';
2454 first_group_count
= nb_buttons
- (dialog_name
[4] - '0');
2456 wv
= first_wv
->contents
;
2457 message
= wv
->value
;
2460 SetRect (&empty_rect
, 0, 0, 0, 0);
2462 /* Create dialog window. */
2463 err
= CreateNewWindow (kMovableModalWindowClass
,
2464 kWindowStandardHandlerAttribute
,
2465 &empty_rect
, &window
);
2467 err
= SetThemeWindowBackground (window
, kThemeBrushMovableModalBackground
,
2470 err
= SetWindowTitleWithCFString (window
, (dialog_name
[0] == 'Q'
2471 ? CFSTR ("Question")
2472 : CFSTR ("Information")));
2474 /* Create button controls and measure their optimal bounds. */
2477 buttons
= alloca (sizeof (ControlRef
) * nb_buttons
);
2478 rects
= alloca (sizeof (Rect
) * nb_buttons
);
2479 for (i
= 0; i
< nb_buttons
; i
++)
2481 CFStringRef label
= cfstring_create_with_utf8_cstring (wv
->value
);
2487 err
= CreatePushButtonControl (window
, &empty_rect
,
2488 label
, &buttons
[i
]);
2496 err
= DisableControl (buttons
[i
]);
2498 err
= DeactivateControl (buttons
[i
]);
2501 else if (default_button
== NULL
)
2502 default_button
= buttons
[i
];
2508 rects
[i
] = empty_rect
;
2509 err
= GetBestControlRect (buttons
[i
], &rects
[i
], &unused
);
2513 OffsetRect (&rects
[i
], -rects
[i
].left
, -rects
[i
].top
);
2514 if (rects
[i
].right
< DIALOG_BUTTON_MIN_WIDTH
)
2515 rects
[i
].right
= DIALOG_BUTTON_MIN_WIDTH
;
2516 else if (rects
[i
].right
> DIALOG_MAX_INNER_WIDTH
)
2517 rects
[i
].right
= DIALOG_MAX_INNER_WIDTH
;
2519 err
= SetControlCommandID (buttons
[i
],
2520 'Bt\0\0' + (int) wv
->call_data
);
2528 /* Layout buttons. rects[i] is set relative to the bottom-right
2529 corner of the inner box. */
2532 short bottom
, right
, max_height
, left_align_shift
;
2534 inner_width
= DIALOG_MIN_INNER_WIDTH
;
2535 bottom
= right
= max_height
= 0;
2536 for (i
= 0; i
< nb_buttons
; i
++)
2538 if (right
- rects
[i
].right
< - inner_width
)
2540 if (i
!= first_group_count
2541 && right
- rects
[i
].right
>= - DIALOG_MAX_INNER_WIDTH
)
2542 inner_width
= - (right
- rects
[i
].right
);
2545 bottom
-= max_height
+ DIALOG_BUTTON_BUTTON_VERTICAL_SPACE
;
2546 right
= max_height
= 0;
2549 if (max_height
< rects
[i
].bottom
)
2550 max_height
= rects
[i
].bottom
;
2551 OffsetRect (&rects
[i
], right
- rects
[i
].right
,
2552 bottom
- rects
[i
].bottom
);
2553 right
= rects
[i
].left
- DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE
;
2554 if (i
== first_group_count
- 1)
2555 right
-= DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE
;
2557 buttons_height
= - (bottom
- max_height
);
2559 left_align_shift
= - (inner_width
+ rects
[nb_buttons
- 1].left
);
2560 for (i
= nb_buttons
- 1; i
>= first_group_count
; i
--)
2562 if (bottom
!= rects
[i
].bottom
)
2564 left_align_shift
= - (inner_width
+ rects
[i
].left
);
2565 bottom
= rects
[i
].bottom
;
2567 OffsetRect (&rects
[i
], left_align_shift
, 0);
2571 /* Create a static text control and measure its bounds. */
2574 CFStringRef message_string
;
2577 message_string
= cfstring_create_with_utf8_cstring (message
);
2578 if (message_string
== NULL
)
2582 ControlFontStyleRec text_style
;
2584 text_style
.flags
= 0;
2585 SetRect (&bounds
, 0, 0, inner_width
, 0);
2586 err
= CreateStaticTextControl (window
, &bounds
, message_string
,
2587 &text_style
, &text
);
2588 CFRelease (message_string
);
2594 bounds
= empty_rect
;
2595 err
= GetBestControlRect (text
, &bounds
, &unused
);
2599 text_height
= bounds
.bottom
- bounds
.top
;
2600 if (text_height
< DIALOG_TEXT_MIN_HEIGHT
)
2601 text_height
= DIALOG_TEXT_MIN_HEIGHT
;
2605 /* Place buttons. */
2608 inner_height
= (text_height
+ DIALOG_TEXT_BUTTONS_VERTICAL_SPACE
2611 for (i
= 0; i
< nb_buttons
; i
++)
2613 OffsetRect (&rects
[i
], DIALOG_LEFT_MARGIN
+ inner_width
,
2614 DIALOG_TOP_MARGIN
+ inner_height
);
2615 SetControlBounds (buttons
[i
], &rects
[i
]);
2624 SetRect (&bounds
, DIALOG_LEFT_MARGIN
, DIALOG_TOP_MARGIN
,
2625 DIALOG_LEFT_MARGIN
+ inner_width
,
2626 DIALOG_TOP_MARGIN
+ text_height
);
2627 SetControlBounds (text
, &bounds
);
2630 /* Create the application icon at the upper-left corner. */
2633 ControlButtonContentInfo content
;
2635 static const ProcessSerialNumber psn
= {0, kCurrentProcess
};
2639 ProcessInfoRec pinfo
;
2644 content
.contentType
= kControlContentIconRef
;
2646 err
= GetProcessBundleLocation (&psn
, &app_location
);
2648 err
= GetIconRefFromFileInfo (&app_location
, 0, NULL
, 0, NULL
,
2649 kIconServicesNormalUsageFlag
,
2650 &content
.u
.iconRef
, &unused
);
2652 bzero (&pinfo
, sizeof (ProcessInfoRec
));
2653 pinfo
.processInfoLength
= sizeof (ProcessInfoRec
);
2654 pinfo
.processAppSpec
= &app_spec
;
2655 err
= GetProcessInformation (&psn
, &pinfo
);
2657 err
= GetIconRefFromFile (&app_spec
, &content
.u
.iconRef
, &unused
);
2663 SetRect (&bounds
, DIALOG_ICON_LEFT_MARGIN
, DIALOG_ICON_TOP_MARGIN
,
2664 DIALOG_ICON_LEFT_MARGIN
+ DIALOG_ICON_WIDTH
,
2665 DIALOG_ICON_TOP_MARGIN
+ DIALOG_ICON_HEIGHT
);
2666 err
= CreateIconControl (window
, &bounds
, &content
, true, &icon
);
2667 ReleaseIconRef (content
.u
.iconRef
);
2671 /* Show the dialog window and run event loop. */
2674 err
= SetWindowDefaultButton (window
, default_button
);
2676 err
= install_dialog_event_handler (window
);
2680 DIALOG_LEFT_MARGIN
+ inner_width
+ DIALOG_RIGHT_MARGIN
,
2681 DIALOG_TOP_MARGIN
+ inner_height
+ DIALOG_BOTTOM_MARGIN
,
2683 err
= RepositionWindow (window
, FRAME_MAC_WINDOW (f
),
2684 kWindowAlertPositionOnParentWindow
);
2688 SetWRefCon (window
, 0);
2689 ShowWindow (window
);
2690 BringToFront (window
);
2691 err
= RunAppModalLoopForWindow (window
);
2695 UInt32 command_id
= GetWRefCon (window
);
2697 if ((command_id
& ~0xffff) == 'Bt\0\0')
2698 result
= command_id
- 'Bt\0\0';
2702 DisposeWindow (window
);
2706 #else /* not TARGET_API_MAC_CARBON */
2708 mac_dialog (widget_value
*wv
)
2712 char **button_labels
;
2719 WindowPtr window_ptr
;
2722 EventRecord event_record
;
2724 int control_part_code
;
2727 dialog_name
= wv
->name
;
2728 nb_buttons
= dialog_name
[1] - '0';
2729 left_count
= nb_buttons
- (dialog_name
[4] - '0');
2730 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
2731 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
2734 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
2735 strcpy (prompt
, wv
->value
);
2739 for (i
= 0; i
< nb_buttons
; i
++)
2741 button_labels
[i
] = wv
->value
;
2742 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
2743 strcpy (button_labels
[i
], wv
->value
);
2744 c2pstr (button_labels
[i
]);
2745 ref_cons
[i
] = (UInt32
) wv
->call_data
;
2749 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
2751 SetPortWindowPort (window_ptr
);
2754 /* Left and right margins in the dialog are 13 pixels each.*/
2756 /* Calculate width of dialog box: 8 pixels on each side of the text
2757 label in each button, 12 pixels between buttons. */
2758 for (i
= 0; i
< nb_buttons
; i
++)
2759 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
2761 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
2764 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
2766 SizeWindow (window_ptr
, dialog_width
, 78, 0);
2767 ShowWindow (window_ptr
);
2769 SetPortWindowPort (window_ptr
);
2774 DrawString (prompt
);
2777 for (i
= 0; i
< nb_buttons
; i
++)
2779 int button_width
= StringWidth (button_labels
[i
]) + 16;
2780 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
2781 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
2782 kControlPushButtonProc
, ref_cons
[i
]);
2783 left
+= button_width
+ 12;
2784 if (i
== left_count
- 1)
2791 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
2792 if (event_record
.what
== mouseDown
)
2794 part_code
= FindWindow (event_record
.where
, &window_ptr
);
2795 if (part_code
== inContent
)
2797 mouse
= event_record
.where
;
2798 GlobalToLocal (&mouse
);
2799 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2800 if (control_part_code
== kControlButtonPart
)
2801 if (TrackControl (ch
, mouse
, NULL
))
2802 i
= GetControlReference (ch
);
2807 DisposeWindow (window_ptr
);
2811 #endif /* not TARGET_API_MAC_CARBON */
2813 static char * button_names
[] = {
2814 "button1", "button2", "button3", "button4", "button5",
2815 "button6", "button7", "button8", "button9", "button10" };
2818 mac_dialog_show (f
, keymaps
, title
, header
, error_name
)
2821 Lisp_Object title
, header
;
2824 int i
, nb_buttons
=0;
2825 char dialog_name
[6];
2826 int menu_item_selection
;
2828 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2830 /* Number of elements seen so far, before boundary. */
2832 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2833 int boundary_seen
= 0;
2837 if (menu_items_n_panes
> 1)
2839 *error_name
= "Multiple panes in dialog box";
2843 /* Create a tree of widget_value objects
2844 representing the text label and buttons. */
2846 Lisp_Object pane_name
, prefix
;
2848 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2849 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2850 pane_string
= (NILP (pane_name
)
2851 ? "" : (char *) SDATA (pane_name
));
2852 prev_wv
= xmalloc_widget_value ();
2853 prev_wv
->value
= pane_string
;
2854 if (keymaps
&& !NILP (prefix
))
2856 prev_wv
->enabled
= 1;
2857 prev_wv
->name
= "message";
2858 prev_wv
->help
= Qnil
;
2861 /* Loop over all panes and items, filling in the tree. */
2862 i
= MENU_ITEMS_PANE_LENGTH
;
2863 while (i
< menu_items_used
)
2866 /* Create a new item within current pane. */
2867 Lisp_Object item_name
, enable
, descrip
;
2868 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2869 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2871 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2873 if (NILP (item_name
))
2875 free_menubar_widget_value_tree (first_wv
);
2876 *error_name
= "Submenu in dialog items";
2879 if (EQ (item_name
, Qquote
))
2881 /* This is the boundary between left-side elts
2882 and right-side elts. Stop incrementing right_count. */
2887 if (nb_buttons
>= 9)
2889 free_menubar_widget_value_tree (first_wv
);
2890 *error_name
= "Too many dialog items";
2894 wv
= xmalloc_widget_value ();
2896 wv
->name
= (char *) button_names
[nb_buttons
];
2897 if (!NILP (descrip
))
2898 wv
->key
= (char *) SDATA (descrip
);
2899 wv
->value
= (char *) SDATA (item_name
);
2900 wv
->call_data
= (void *) i
;
2901 /* menu item is identified by its index in menu_items table */
2902 wv
->enabled
= !NILP (enable
);
2906 if (! boundary_seen
)
2910 i
+= MENU_ITEMS_ITEM_LENGTH
;
2913 /* If the boundary was not specified,
2914 by default put half on the left and half on the right. */
2915 if (! boundary_seen
)
2916 left_count
= nb_buttons
- nb_buttons
/ 2;
2918 wv
= xmalloc_widget_value ();
2919 wv
->name
= dialog_name
;
2922 /* Frame title: 'Q' = Question, 'I' = Information.
2923 Can also have 'E' = Error if, one day, we want
2924 a popup for errors. */
2926 dialog_name
[0] = 'Q';
2928 dialog_name
[0] = 'I';
2930 /* Dialog boxes use a really stupid name encoding
2931 which specifies how many buttons to use
2932 and how many buttons are on the right. */
2933 dialog_name
[1] = '0' + nb_buttons
;
2934 dialog_name
[2] = 'B';
2935 dialog_name
[3] = 'R';
2936 /* Number of buttons to put on the right. */
2937 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2939 wv
->contents
= first_wv
;
2943 /* Actually create the dialog. */
2944 #if TARGET_API_MAC_CARBON
2945 menu_item_selection
= create_and_show_dialog (f
, first_wv
);
2947 menu_item_selection
= mac_dialog (first_wv
);
2950 /* Free the widget_value objects we used to specify the contents. */
2951 free_menubar_widget_value_tree (first_wv
);
2953 /* Find the selected item, and its pane, to return
2954 the proper value. */
2955 if (menu_item_selection
!= 0)
2961 while (i
< menu_items_used
)
2965 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2968 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2969 i
+= MENU_ITEMS_PANE_LENGTH
;
2971 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2973 /* This is the boundary between left-side elts and
2980 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2981 if (menu_item_selection
== i
)
2985 entry
= Fcons (entry
, Qnil
);
2987 entry
= Fcons (prefix
, entry
);
2991 i
+= MENU_ITEMS_ITEM_LENGTH
;
2996 /* Make "Cancel" equivalent to C-g. */
2997 Fsignal (Qquit
, Qnil
);
3001 #endif /* HAVE_DIALOGS */
3004 /* Is this item a separator? */
3006 name_is_separator (name
)
3009 const char *start
= name
;
3011 /* Check if name string consists of only dashes ('-'). */
3012 while (*name
== '-') name
++;
3013 /* Separators can also be of the form "--:TripleSuperMegaEtched"
3014 or "--deep-shadow". We don't implement them yet, se we just treat
3015 them like normal separators. */
3016 return (*name
== '\0' || start
+ 2 == name
);
3020 add_menu_item (menu
, pos
, wv
)
3025 #if TARGET_API_MAC_CARBON
3026 CFStringRef item_name
;
3031 if (name_is_separator (wv
->name
))
3032 AppendMenu (menu
, "\p-");
3035 AppendMenu (menu
, "\pX");
3037 #if TARGET_API_MAC_CARBON
3038 item_name
= cfstring_create_with_utf8_cstring (wv
->name
);
3040 if (wv
->key
!= NULL
)
3042 CFStringRef name
, key
;
3045 key
= cfstring_create_with_utf8_cstring (wv
->key
);
3046 item_name
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@ %@"),
3052 SetMenuItemTextWithCFString (menu
, pos
, item_name
);
3053 CFRelease (item_name
);
3056 EnableMenuItem (menu
, pos
);
3058 DisableMenuItem (menu
, pos
);
3060 if (STRINGP (wv
->help
))
3061 SetMenuItemProperty (menu
, pos
, MAC_EMACS_CREATOR_CODE
, 'help',
3062 sizeof (Lisp_Object
), &wv
->help
);
3063 #else /* ! TARGET_API_MAC_CARBON */
3064 item_name
[sizeof (item_name
) - 1] = '\0';
3065 strncpy (item_name
, wv
->name
, sizeof (item_name
) - 1);
3066 if (wv
->key
!= NULL
)
3068 int len
= strlen (item_name
);
3070 strncpy (item_name
+ len
, " ", sizeof (item_name
) - 1 - len
);
3071 len
= strlen (item_name
);
3072 strncpy (item_name
+ len
, wv
->key
, sizeof (item_name
) - 1 - len
);
3075 SetMenuItemText (menu
, pos
, item_name
);
3078 EnableItem (menu
, pos
);
3080 DisableItem (menu
, pos
);
3081 #endif /* ! TARGET_API_MAC_CARBON */
3083 /* Draw radio buttons and tickboxes. */
3084 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
3085 wv
->button_type
== BUTTON_TYPE_RADIO
))
3086 SetItemMark (menu
, pos
, checkMark
);
3088 SetItemMark (menu
, pos
, noMark
);
3090 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
3094 /* Construct native Mac OS menu based on widget_value tree. */
3097 fill_menu (menu
, wv
, kind
, submenu_id
)
3100 enum mac_menu_kind kind
;
3105 for (pos
= 1; wv
!= NULL
; wv
= wv
->next
, pos
++)
3107 add_menu_item (menu
, pos
, wv
);
3108 if (wv
->contents
&& submenu_id
< min_menu_id
[kind
+ 1])
3110 MenuHandle submenu
= NewMenu (submenu_id
, "\pX");
3112 InsertMenu (submenu
, -1);
3113 SetMenuItemHierarchicalID (menu
, pos
, submenu_id
);
3114 submenu_id
= fill_menu (submenu
, wv
->contents
, kind
, submenu_id
+ 1);
3121 /* Construct native Mac OS menubar based on widget_value tree. */
3124 fill_menubar (wv
, deep_p
)
3131 #if !TARGET_API_MAC_CARBON
3132 int title_changed_p
= 0;
3135 /* Clean up the menu bar when filled by the entire menu trees. */
3138 dispose_menus (MAC_MENU_MENU_BAR
, 0);
3139 dispose_menus (MAC_MENU_MENU_BAR_SUB
, 0);
3140 #if !TARGET_API_MAC_CARBON
3141 title_changed_p
= 1;
3145 /* Fill menu bar titles and submenus. Reuse the existing menu bar
3146 titles as much as possible to minimize redraw (if !deep_p). */
3147 submenu_id
= min_menu_id
[MAC_MENU_MENU_BAR_SUB
];
3148 for (id
= min_menu_id
[MAC_MENU_MENU_BAR
];
3149 wv
!= NULL
&& id
< min_menu_id
[MAC_MENU_MENU_BAR
+ 1];
3150 wv
= wv
->next
, id
++)
3152 strncpy (title
, wv
->name
, 255);
3156 menu
= GetMenuHandle (id
);
3159 #if TARGET_API_MAC_CARBON
3162 GetMenuTitle (menu
, old_title
);
3163 if (!EqualString (title
, old_title
, false, false))
3164 SetMenuTitle (menu
, title
);
3165 #else /* !TARGET_API_MAC_CARBON */
3166 if (!EqualString (title
, (*menu
)->menuData
, false, false))
3170 menu
= NewMenu (id
, title
);
3171 InsertMenu (menu
, GetMenuHandle (id
+ 1) ? id
+ 1 : 0);
3172 title_changed_p
= 1;
3174 #endif /* !TARGET_API_MAC_CARBON */
3178 menu
= NewMenu (id
, title
);
3179 InsertMenu (menu
, 0);
3180 #if !TARGET_API_MAC_CARBON
3181 title_changed_p
= 1;
3186 submenu_id
= fill_menu (menu
, wv
->contents
, MAC_MENU_MENU_BAR_SUB
,
3190 if (id
< min_menu_id
[MAC_MENU_MENU_BAR
+ 1] && GetMenuHandle (id
))
3192 dispose_menus (MAC_MENU_MENU_BAR
, id
);
3193 #if !TARGET_API_MAC_CARBON
3194 title_changed_p
= 1;
3198 #if !TARGET_API_MAC_CARBON
3199 if (title_changed_p
)
3204 /* Dispose of menus that belong to KIND, and remove them from the menu
3205 list. ID is the lower bound of menu IDs that will be processed. */
3208 dispose_menus (kind
, id
)
3209 enum mac_menu_kind kind
;
3212 for (id
= max (id
, min_menu_id
[kind
]); id
< min_menu_id
[kind
+ 1]; id
++)
3214 MenuHandle menu
= GetMenuHandle (id
);
3223 #endif /* HAVE_MENUS */
3225 /* The following is used by delayed window autoselection. */
3227 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
3228 doc
: /* Return t if a menu or popup dialog is active. */)
3231 /* Always return Qnil since menu selection functions do not return
3232 until a selection has been made or cancelled. */
3239 staticpro (&menu_items
);
3242 Qdebug_on_next_call
= intern ("debug-on-next-call");
3243 staticpro (&Qdebug_on_next_call
);
3245 defsubr (&Sx_popup_menu
);
3246 defsubr (&Smenu_or_popup_active_p
);
3248 defsubr (&Sx_popup_dialog
);
3252 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
3253 (do not change this comment) */