1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
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 #define HAVE_DIALOGS 1
82 #undef HAVE_MULTILINGUAL_MENU
83 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
85 /******************************************************************/
86 /* Definitions copied from lwlib.h */
88 typedef void * XtPointer
;
97 /* This structure is based on the one in ../lwlib/lwlib.h, modified
99 typedef struct _widget_value
104 /* value (meaning depend on widget type) */
106 /* keyboard equivalent. no implications for XtTranslations */
109 /* Help string or nil if none.
110 GC finds this string through the frame's menu_bar_vector
111 or through menu_items. */
113 /* true if enabled */
115 /* true if selected */
117 /* The type of a button. */
118 enum button_type button_type
;
119 /* true if menu title */
122 /* true if was edited (maintained by get_value) */
124 /* true if has changed (maintained by lw library) */
126 /* true if this widget itself has changed,
127 but not counting the other widgets found in the `next' field. */
128 change_type this_one_change
;
130 /* Contents of the sub-widgets, also selected slot for checkbox */
131 struct _widget_value
* contents
;
132 /* data passed to callback */
134 /* next one in the list */
135 struct _widget_value
* next
;
137 /* slot for the toolkit dependent part. Always initialize to NULL. */
139 /* tell us if we should free the toolkit data slot when freeing the
140 widget_value itself. */
141 Boolean free_toolkit_data
;
143 /* we resource the widget_value structures; this points to the next
144 one on the free list if this one has been deallocated.
146 struct _widget_value
*free_list
;
150 /* Assumed by other routines to zero area returned. */
151 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
152 0, (sizeof (widget_value)))
153 #define free_widget_value(wv) xfree (wv)
155 /******************************************************************/
162 Lisp_Object Qdebug_on_next_call
;
164 extern Lisp_Object Vmenu_updating_frame
;
166 extern Lisp_Object Qmenu_bar
, Qmac_apple_event
;
168 extern Lisp_Object QCtoggle
, QCradio
;
170 extern Lisp_Object Voverriding_local_map
;
171 extern Lisp_Object Voverriding_local_map_menu_flag
;
173 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
175 extern Lisp_Object Qmenu_bar_update_hook
;
177 void set_frame_menubar
P_ ((FRAME_PTR
, int, int));
179 #if TARGET_API_MAC_CARBON
180 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
182 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
185 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
186 Lisp_Object
, Lisp_Object
, Lisp_Object
,
187 Lisp_Object
, Lisp_Object
));
189 static Lisp_Object mac_dialog_show
P_ ((FRAME_PTR
, int, Lisp_Object
,
190 Lisp_Object
, char **));
192 static Lisp_Object mac_menu_show
P_ ((struct frame
*, int, int, int, int,
193 Lisp_Object
, char **));
194 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
195 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
197 static void list_of_panes
P_ ((Lisp_Object
));
198 static void list_of_items
P_ ((Lisp_Object
));
200 static void find_and_call_menu_selection
P_ ((FRAME_PTR
, int, Lisp_Object
,
202 static int fill_menu
P_ ((MenuHandle
, widget_value
*, enum mac_menu_kind
, int));
203 static void fill_menubar
P_ ((widget_value
*, int));
204 static void dispose_menus
P_ ((enum mac_menu_kind
, int));
207 /* This holds a Lisp vector that holds the results of decoding
208 the keymaps or alist-of-alists that specify a menu.
210 It describes the panes and items within the panes.
212 Each pane is described by 3 elements in the vector:
213 t, the pane name, the pane's prefix key.
214 Then follow the pane's items, with 5 elements per item:
215 the item string, the enable flag, the item's value,
216 the definition, and the equivalent keyboard key's description string.
218 In some cases, multiple levels of menus may be described.
219 A single vector slot containing nil indicates the start of a submenu.
220 A single vector slot containing lambda indicates the end of a submenu.
221 The submenu follows a menu item which is the way to reach the submenu.
223 A single vector slot containing quote indicates that the
224 following items should appear on the right of a dialog box.
226 Using a Lisp vector to hold this information while we decode it
227 takes care of protecting all the data from GC. */
229 #define MENU_ITEMS_PANE_NAME 1
230 #define MENU_ITEMS_PANE_PREFIX 2
231 #define MENU_ITEMS_PANE_LENGTH 3
235 MENU_ITEMS_ITEM_NAME
= 0,
236 MENU_ITEMS_ITEM_ENABLE
,
237 MENU_ITEMS_ITEM_VALUE
,
238 MENU_ITEMS_ITEM_EQUIV_KEY
,
239 MENU_ITEMS_ITEM_DEFINITION
,
240 MENU_ITEMS_ITEM_TYPE
,
241 MENU_ITEMS_ITEM_SELECTED
,
242 MENU_ITEMS_ITEM_HELP
,
243 MENU_ITEMS_ITEM_LENGTH
246 static Lisp_Object menu_items
;
248 /* Number of slots currently allocated in menu_items. */
249 static int menu_items_allocated
;
251 /* This is the index in menu_items of the first empty slot. */
252 static int menu_items_used
;
254 /* The number of panes currently recorded in menu_items,
255 excluding those within submenus. */
256 static int menu_items_n_panes
;
258 /* Current depth within submenus. */
259 static int menu_items_submenu_depth
;
261 /* This is set nonzero after the user activates the menu bar, and set
262 to zero again after the menu bars are redisplayed by prepare_menu_bar.
263 While it is nonzero, all calls to set_frame_menubar go deep.
265 I don't understand why this is needed, but it does seem to be
266 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
268 int pending_menu_activation
;
270 /* Initialize the menu_items structure if we haven't already done so.
271 Also mark it as currently empty. */
276 if (NILP (menu_items
))
278 menu_items_allocated
= 60;
279 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
283 menu_items_n_panes
= 0;
284 menu_items_submenu_depth
= 0;
287 /* Call at the end of generating the data in menu_items. */
294 /* Call when finished using the data for the current menu
298 discard_menu_items ()
300 /* Free the structure if it is especially large.
301 Otherwise, hold on to it, to save time. */
302 if (menu_items_allocated
> 200)
305 menu_items_allocated
= 0;
309 /* This undoes save_menu_items, and it is called by the specpdl unwind
313 restore_menu_items (saved
)
316 menu_items
= XCAR (saved
);
317 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
318 saved
= XCDR (saved
);
319 menu_items_used
= XINT (XCAR (saved
));
320 saved
= XCDR (saved
);
321 menu_items_n_panes
= XINT (XCAR (saved
));
322 saved
= XCDR (saved
);
323 menu_items_submenu_depth
= XINT (XCAR (saved
));
327 /* Push the whole state of menu_items processing onto the specpdl.
328 It will be restored when the specpdl is unwound. */
333 Lisp_Object saved
= list4 (menu_items
,
334 make_number (menu_items_used
),
335 make_number (menu_items_n_panes
),
336 make_number (menu_items_submenu_depth
));
337 record_unwind_protect (restore_menu_items
, saved
);
341 /* Make the menu_items vector twice as large. */
347 int old_size
= menu_items_allocated
;
350 menu_items_allocated
*= 2;
352 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
353 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
354 old_size
* sizeof (Lisp_Object
));
357 /* Begin a submenu. */
360 push_submenu_start ()
362 if (menu_items_used
+ 1 > menu_items_allocated
)
365 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
366 menu_items_submenu_depth
++;
374 if (menu_items_used
+ 1 > menu_items_allocated
)
377 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
378 menu_items_submenu_depth
--;
381 /* Indicate boundary between left and right. */
384 push_left_right_boundary ()
386 if (menu_items_used
+ 1 > menu_items_allocated
)
389 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
392 /* Start a new menu pane in menu_items.
393 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
396 push_menu_pane (name
, prefix_vec
)
397 Lisp_Object name
, prefix_vec
;
399 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
402 if (menu_items_submenu_depth
== 0)
403 menu_items_n_panes
++;
404 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
405 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
406 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
409 /* Push one menu item into the current pane. NAME is the string to
410 display. ENABLE if non-nil means this item can be selected. KEY
411 is the key generated by choosing this item, or nil if this item
412 doesn't really have a definition. DEF is the definition of this
413 item. EQUIV is the textual description of the keyboard equivalent
414 for this item (or nil if none). TYPE is the type of this menu
415 item, one of nil, `toggle' or `radio'. */
418 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
419 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
421 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
424 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
425 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
426 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
427 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
428 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
429 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
430 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
431 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
434 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
435 and generate menu panes for them in menu_items.
436 If NOTREAL is nonzero,
437 don't bother really computing whether an item is enabled. */
440 keymap_panes (keymaps
, nmaps
, notreal
)
441 Lisp_Object
*keymaps
;
449 /* Loop over the given keymaps, making a pane for each map.
450 But don't make a pane that is empty--ignore that map instead.
451 P is the number of panes we have made so far. */
452 for (mapno
= 0; mapno
< nmaps
; mapno
++)
453 single_keymap_panes (keymaps
[mapno
],
454 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
456 finish_menu_items ();
459 /* Args passed between single_keymap_panes and single_menu_item. */
462 Lisp_Object pending_maps
;
463 int maxdepth
, notreal
;
466 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
469 /* This is a recursive subroutine of keymap_panes.
470 It handles one keymap, KEYMAP.
471 The other arguments are passed along
472 or point to local variables of the previous function.
473 If NOTREAL is nonzero, only check for equivalent key bindings, don't
474 evaluate expressions in menu items and don't make any menu.
476 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
479 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
481 Lisp_Object pane_name
;
489 skp
.pending_maps
= Qnil
;
490 skp
.maxdepth
= maxdepth
;
491 skp
.notreal
= notreal
;
496 push_menu_pane (pane_name
, prefix
);
498 GCPRO1 (skp
.pending_maps
);
499 map_keymap (keymap
, single_menu_item
, Qnil
, &skp
, 1);
502 /* Process now any submenus which want to be panes at this level. */
503 while (CONSP (skp
.pending_maps
))
505 Lisp_Object elt
, eltcdr
, string
;
506 elt
= XCAR (skp
.pending_maps
);
508 string
= XCAR (eltcdr
);
509 /* We no longer discard the @ from the beginning of the string here.
510 Instead, we do this in mac_menu_show. */
511 single_keymap_panes (Fcar (elt
), string
,
512 XCDR (eltcdr
), notreal
, maxdepth
- 1);
513 skp
.pending_maps
= XCDR (skp
.pending_maps
);
517 /* This is a subroutine of single_keymap_panes that handles one
519 KEY is a key in a keymap and ITEM is its binding.
520 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
522 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
523 evaluate expressions in menu items and don't make any menu.
524 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
527 single_menu_item (key
, item
, dummy
, skp_v
)
528 Lisp_Object key
, item
, dummy
;
531 Lisp_Object map
, item_string
, enabled
;
532 struct gcpro gcpro1
, gcpro2
;
534 struct skp
*skp
= skp_v
;
536 /* Parse the menu item and leave the result in item_properties. */
538 res
= parse_menu_item (item
, skp
->notreal
, 0);
541 return; /* Not a menu item. */
543 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
547 /* We don't want to make a menu, just traverse the keymaps to
548 precompute equivalent key bindings. */
550 single_keymap_panes (map
, Qnil
, key
, 1, skp
->maxdepth
- 1);
554 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
555 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
557 if (!NILP (map
) && SREF (item_string
, 0) == '@')
560 /* An enabled separate pane. Remember this to handle it later. */
561 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
566 push_menu_item (item_string
, enabled
, key
,
567 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
568 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
569 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
570 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
571 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
573 /* Display a submenu using the toolkit. */
574 if (! (NILP (map
) || NILP (enabled
)))
576 push_submenu_start ();
577 single_keymap_panes (map
, Qnil
, key
, 0, skp
->maxdepth
- 1);
582 /* Push all the panes and items of a menu described by the
583 alist-of-alists MENU.
584 This handles old-fashioned calls to x-popup-menu. */
594 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
596 Lisp_Object elt
, pane_name
, pane_data
;
598 pane_name
= Fcar (elt
);
599 CHECK_STRING (pane_name
);
600 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
601 pane_data
= Fcdr (elt
);
602 CHECK_CONS (pane_data
);
603 list_of_items (pane_data
);
606 finish_menu_items ();
609 /* Push the items in a single pane defined by the alist PANE. */
615 Lisp_Object tail
, item
, item1
;
617 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
621 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
622 Qnil
, Qnil
, Qnil
, Qnil
);
623 else if (CONSP (item
))
626 CHECK_STRING (item1
);
627 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
628 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
631 push_left_right_boundary ();
637 cleanup_popup_menu (arg
)
640 discard_menu_items ();
644 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
645 doc
: /* Pop up a deck-of-cards menu and return user's selection.
646 POSITION is a position specification. This is either a mouse button event
647 or a list ((XOFFSET YOFFSET) WINDOW)
648 where XOFFSET and YOFFSET are positions in pixels from the top left
649 corner of WINDOW. (WINDOW may be a window or a frame object.)
650 This controls the position of the top left of the menu as a whole.
651 If POSITION is t, it means to use the current mouse position.
653 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
654 The menu items come from key bindings that have a menu string as well as
655 a definition; actually, the "definition" in such a key binding looks like
656 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
657 the keymap as a top-level element.
659 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
660 Otherwise, REAL-DEFINITION should be a valid key binding definition.
662 You can also use a list of keymaps as MENU.
663 Then each keymap makes a separate pane.
665 When MENU is a keymap or a list of keymaps, the return value is the
666 list of events corresponding to the user's choice. Note that
667 `x-popup-menu' does not actually execute the command bound to that
670 Alternatively, you can specify a menu of multiple panes
671 with a list of the form (TITLE PANE1 PANE2...),
672 where each pane is a list of form (TITLE ITEM1 ITEM2...).
673 Each ITEM is normally a cons cell (STRING . VALUE);
674 but a string can appear as an item--that makes a nonselectable line
676 With this form of menu, the return value is VALUE from the chosen item.
678 If POSITION is nil, don't display the menu at all, just precalculate the
679 cached information about equivalent key sequences.
681 If the user gets rid of the menu without making a valid choice, for
682 instance by clicking the mouse away from a valid choice or by typing
683 keyboard input, then this normally results in a quit and
684 `x-popup-menu' does not return. But if POSITION is a mouse button
685 event (indicating that the user invoked the menu with the mouse) then
686 no quit occurs and `x-popup-menu' returns nil. */)
688 Lisp_Object position
, menu
;
690 Lisp_Object keymap
, tem
;
691 int xpos
= 0, ypos
= 0;
693 char *error_name
= NULL
;
694 Lisp_Object selection
;
696 Lisp_Object x
, y
, window
;
699 int specpdl_count
= SPECPDL_INDEX ();
703 if (! NILP (position
))
707 /* Decode the first argument: find the window and the coordinates. */
708 if (EQ (position
, Qt
)
709 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
710 || EQ (XCAR (position
), Qtool_bar
)
711 || EQ (XCAR (position
), Qmac_apple_event
))))
713 /* Use the mouse's current position. */
714 FRAME_PTR new_f
= SELECTED_FRAME ();
715 Lisp_Object bar_window
;
716 enum scroll_bar_part part
;
719 if (mouse_position_hook
)
720 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
721 &part
, &x
, &y
, &time
);
723 XSETFRAME (window
, new_f
);
726 window
= selected_window
;
733 tem
= Fcar (position
);
736 window
= Fcar (Fcdr (position
));
738 y
= Fcar (XCDR (tem
));
743 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
744 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
745 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
754 /* Decode where to put the menu. */
762 else if (WINDOWP (window
))
764 CHECK_LIVE_WINDOW (window
);
765 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
767 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
768 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
771 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
772 but I don't want to make one now. */
773 CHECK_WINDOW (window
);
778 XSETFRAME (Vmenu_updating_frame
, f
);
781 Vmenu_updating_frame
= Qnil
;
782 #endif /* HAVE_MENUS */
787 /* Decode the menu items from what was specified. */
789 keymap
= get_keymap (menu
, 0, 0);
792 /* We were given a keymap. Extract menu info from the keymap. */
795 /* Extract the detailed info to make one pane. */
796 keymap_panes (&menu
, 1, NILP (position
));
798 /* Search for a string appearing directly as an element of the keymap.
799 That string is the title of the menu. */
800 prompt
= Fkeymap_prompt (keymap
);
801 if (NILP (title
) && !NILP (prompt
))
804 /* Make that be the pane title of the first pane. */
805 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
806 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
810 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
812 /* We were given a list of keymaps. */
813 int nmaps
= XFASTINT (Flength (menu
));
815 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
820 /* The first keymap that has a prompt string
821 supplies the menu title. */
822 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
826 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
828 prompt
= Fkeymap_prompt (keymap
);
829 if (NILP (title
) && !NILP (prompt
))
833 /* Extract the detailed info to make one pane. */
834 keymap_panes (maps
, nmaps
, NILP (position
));
836 /* Make the title be the pane title of the first pane. */
837 if (!NILP (title
) && menu_items_n_panes
>= 0)
838 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
844 /* We were given an old-fashioned menu. */
846 CHECK_STRING (title
);
848 list_of_panes (Fcdr (menu
));
855 discard_menu_items ();
861 /* Display them in a menu. */
862 record_unwind_protect (cleanup_popup_menu
, Qnil
);
865 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
866 keymaps
, title
, &error_name
);
868 unbind_to (specpdl_count
, Qnil
);
871 #endif /* HAVE_MENUS */
873 if (error_name
) error (error_name
);
879 /* Regard ESC and C-g as Cancel even without the Cancel button. */
883 mac_dialog_modal_filter (dialog
, event
, item_hit
)
886 DialogItemIndex
*item_hit
;
890 result
= StdFilterProc (dialog
, event
, item_hit
);
892 && (event
->what
== keyDown
|| event
->what
== autoKey
)
893 && ((event
->message
& charCodeMask
) == kEscapeCharCode
894 || mac_quit_char_key_p (event
->modifiers
,
895 (event
->message
& keyCodeMask
) >> 8)))
897 *item_hit
= kStdCancelItemIndex
;
905 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
906 doc
: /* Pop up a dialog box and return user's selection.
907 POSITION specifies which frame to use.
908 This is normally a mouse button event or a window or frame.
909 If POSITION is t, it means to use the frame the mouse is on.
910 The dialog box appears in the middle of the specified frame.
912 CONTENTS specifies the alternatives to display in the dialog box.
913 It is a list of the form (DIALOG ITEM1 ITEM2...).
914 Each ITEM is a cons cell (STRING . VALUE).
915 The return value is VALUE from the chosen item.
917 An ITEM may also be just a string--that makes a nonselectable item.
918 An ITEM may also be nil--that means to put all preceding items
919 on the left of the dialog box and all following items on the right.
920 \(By default, approximately half appear on each side.)
922 If HEADER is non-nil, the frame title for the box is "Information",
923 otherwise it is "Question".
925 If the user gets rid of the dialog box without making a valid choice,
926 for instance using the window manager, then this produces a quit and
927 `x-popup-dialog' does not return. */)
928 (position
, contents
, header
)
929 Lisp_Object position
, contents
, header
;
936 /* Decode the first argument: find the window or frame to use. */
937 if (EQ (position
, Qt
)
938 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
939 || EQ (XCAR (position
), Qtool_bar
)
940 || EQ (XCAR (position
), Qmac_apple_event
))))
942 #if 0 /* Using the frame the mouse is on may not be right. */
943 /* Use the mouse's current position. */
944 FRAME_PTR new_f
= SELECTED_FRAME ();
945 Lisp_Object bar_window
;
946 enum scroll_bar_part part
;
950 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
953 XSETFRAME (window
, new_f
);
955 window
= selected_window
;
957 window
= selected_window
;
959 else if (CONSP (position
))
962 tem
= Fcar (position
);
964 window
= Fcar (Fcdr (position
));
967 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
968 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
971 else if (WINDOWP (position
) || FRAMEP (position
))
976 /* Decode where to put the menu. */
980 else if (WINDOWP (window
))
982 CHECK_LIVE_WINDOW (window
);
983 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
986 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
987 but I don't want to make one now. */
988 CHECK_WINDOW (window
);
991 /* Special treatment for Fmessage_box, Fyes_or_no_p, and Fy_or_n_p. */
992 if (EQ (position
, Qt
)
993 && STRINGP (Fcar (contents
))
994 && ((!NILP (Fequal (XCDR (contents
),
995 Fcons (Fcons (build_string ("OK"), Qt
), Qnil
)))
997 || (!NILP (Fequal (XCDR (contents
),
998 Fcons (Fcons (build_string ("Yes"), Qt
),
999 Fcons (Fcons (build_string ("No"), Qnil
),
1003 OSStatus err
= noErr
;
1004 AlertStdCFStringAlertParamRec param
;
1005 CFStringRef error_string
, explanation_string
;
1007 DialogItemIndex item_hit
;
1010 tem
= Fstring_match (concat3 (build_string ("\\("),
1011 call0 (intern ("sentence-end")),
1012 build_string ("\\)\n")),
1013 XCAR (contents
), Qnil
);
1017 error_string
= cfstring_create_with_string (XCAR (contents
));
1018 if (error_string
== NULL
)
1020 explanation_string
= NULL
;
1024 tem
= Fmatch_end (make_number (1));
1026 cfstring_create_with_string (Fsubstring (XCAR (contents
),
1027 make_number (0), tem
));
1028 if (error_string
== NULL
)
1032 XSETINT (tem
, XINT (tem
) + 1);
1033 explanation_string
=
1034 cfstring_create_with_string (Fsubstring (XCAR (contents
),
1036 if (explanation_string
== NULL
)
1038 CFRelease (error_string
);
1044 err
= GetStandardAlertDefaultParams (¶m
,
1045 kStdCFStringAlertVersionOne
);
1048 param
.movable
= true;
1049 param
.position
= kWindowAlertPositionParentWindow
;
1052 param
.defaultText
= CFSTR ("Yes");
1053 param
.otherText
= CFSTR ("No");
1055 param
.cancelText
= CFSTR ("Cancel");
1056 param
.cancelButton
= kAlertStdAlertCancelButton
;
1059 err
= CreateStandardAlert (kAlertNoteAlert
, error_string
,
1060 explanation_string
, ¶m
, &alert
);
1061 CFRelease (error_string
);
1062 if (explanation_string
)
1063 CFRelease (explanation_string
);
1066 err
= RunStandardAlert (alert
, mac_dialog_modal_filter
, &item_hit
);
1071 if (item_hit
== kStdCancelItemIndex
)
1072 Fsignal (Qquit
, Qnil
);
1073 else if (item_hit
== kStdOkItemIndex
)
1080 #ifndef HAVE_DIALOGS
1081 /* Display a menu with these alternatives
1082 in the middle of frame F. */
1084 Lisp_Object x
, y
, frame
, newpos
;
1085 XSETFRAME (frame
, f
);
1086 XSETINT (x
, x_pixel_width (f
) / 2);
1087 XSETINT (y
, x_pixel_height (f
) / 2);
1088 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
1090 return Fx_popup_menu (newpos
,
1091 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
1093 #else /* HAVE_DIALOGS */
1097 Lisp_Object selection
;
1098 int specpdl_count
= SPECPDL_INDEX ();
1100 /* Decode the dialog items from what was specified. */
1101 title
= Fcar (contents
);
1102 CHECK_STRING (title
);
1104 list_of_panes (Fcons (contents
, Qnil
));
1106 /* Display them in a dialog box. */
1107 record_unwind_protect (cleanup_popup_menu
, Qnil
);
1109 selection
= mac_dialog_show (f
, 0, title
, header
, &error_name
);
1111 unbind_to (specpdl_count
, Qnil
);
1113 if (error_name
) error (error_name
);
1116 #endif /* HAVE_DIALOGS */
1119 /* Activate the menu bar of frame F.
1120 This is called from keyboard.c when it gets the
1121 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1123 To activate the menu bar, we use the button-press event location
1124 that was saved in saved_menu_event_location.
1126 But first we recompute the menu bar contents (the whole tree).
1128 The reason for saving the button event until here, instead of
1129 passing it to the toolkit right away, is that we can safely
1130 execute Lisp code. */
1133 x_activate_menubar (f
)
1137 SInt16 menu_id
, menu_item
;
1138 extern Point saved_menu_event_location
;
1140 set_frame_menubar (f
, 0, 1);
1143 menu_choice
= MenuSelect (saved_menu_event_location
);
1144 menu_id
= HiWord (menu_choice
);
1145 menu_item
= LoWord (menu_choice
);
1147 #if !TARGET_API_MAC_CARBON
1148 if (menu_id
== min_menu_id
[MAC_MENU_M_APPLE
])
1149 do_apple_menu (menu_item
);
1154 MenuHandle menu
= GetMenuHandle (menu_id
);
1160 GetMenuItemRefCon (menu
, menu_item
, &refcon
);
1161 find_and_call_menu_selection (f
, f
->menu_bar_items_used
,
1162 f
->menu_bar_vector
, (void *) refcon
);
1171 /* Find the menu selection and store it in the keyboard buffer.
1172 F is the frame the menu is on.
1173 MENU_BAR_ITEMS_USED is the length of VECTOR.
1174 VECTOR is an array of menu events for the whole menu. */
1177 find_and_call_menu_selection (f
, menu_bar_items_used
, vector
, client_data
)
1179 int menu_bar_items_used
;
1183 Lisp_Object prefix
, entry
;
1184 Lisp_Object
*subprefix_stack
;
1185 int submenu_depth
= 0;
1189 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
1193 while (i
< menu_bar_items_used
)
1195 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1197 subprefix_stack
[submenu_depth
++] = prefix
;
1201 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1203 prefix
= subprefix_stack
[--submenu_depth
];
1206 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1208 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1209 i
+= MENU_ITEMS_PANE_LENGTH
;
1213 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1214 /* The EMACS_INT cast avoids a warning. There's no problem
1215 as long as pointers have enough bits to hold small integers. */
1216 if ((int) (EMACS_INT
) client_data
== i
)
1219 struct input_event buf
;
1223 XSETFRAME (frame
, f
);
1224 buf
.kind
= MENU_BAR_EVENT
;
1225 buf
.frame_or_window
= frame
;
1227 kbd_buffer_store_event (&buf
);
1229 for (j
= 0; j
< submenu_depth
; j
++)
1230 if (!NILP (subprefix_stack
[j
]))
1232 buf
.kind
= MENU_BAR_EVENT
;
1233 buf
.frame_or_window
= frame
;
1234 buf
.arg
= subprefix_stack
[j
];
1235 kbd_buffer_store_event (&buf
);
1240 buf
.kind
= MENU_BAR_EVENT
;
1241 buf
.frame_or_window
= frame
;
1243 kbd_buffer_store_event (&buf
);
1246 buf
.kind
= MENU_BAR_EVENT
;
1247 buf
.frame_or_window
= frame
;
1249 kbd_buffer_store_event (&buf
);
1253 i
+= MENU_ITEMS_ITEM_LENGTH
;
1258 /* Allocate a widget_value, blocking input. */
1261 xmalloc_widget_value ()
1263 widget_value
*value
;
1266 value
= malloc_widget_value ();
1272 /* This recursively calls free_widget_value on the tree of widgets.
1273 It must free all data that was malloc'ed for these widget_values.
1274 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1275 must be left alone. */
1278 free_menubar_widget_value_tree (wv
)
1283 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1285 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1287 free_menubar_widget_value_tree (wv
->contents
);
1288 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1292 free_menubar_widget_value_tree (wv
->next
);
1293 wv
->next
= (widget_value
*) 0xDEADBEEF;
1296 free_widget_value (wv
);
1300 /* Set up data in menu_items for a menu bar item
1301 whose event type is ITEM_KEY (with string ITEM_NAME)
1302 and whose contents come from the list of keymaps MAPS. */
1305 parse_single_submenu (item_key
, item_name
, maps
)
1306 Lisp_Object item_key
, item_name
, maps
;
1310 Lisp_Object
*mapvec
;
1312 int top_level_items
= 0;
1314 length
= Flength (maps
);
1315 len
= XINT (length
);
1317 /* Convert the list MAPS into a vector MAPVEC. */
1318 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1319 for (i
= 0; i
< len
; i
++)
1321 mapvec
[i
] = Fcar (maps
);
1325 /* Loop over the given keymaps, making a pane for each map.
1326 But don't make a pane that is empty--ignore that map instead. */
1327 for (i
= 0; i
< len
; i
++)
1329 if (!KEYMAPP (mapvec
[i
]))
1331 /* Here we have a command at top level in the menu bar
1332 as opposed to a submenu. */
1333 top_level_items
= 1;
1334 push_menu_pane (Qnil
, Qnil
);
1335 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1336 Qnil
, Qnil
, Qnil
, Qnil
);
1341 prompt
= Fkeymap_prompt (mapvec
[i
]);
1342 single_keymap_panes (mapvec
[i
],
1343 !NILP (prompt
) ? prompt
: item_name
,
1348 return top_level_items
;
1351 /* Create a tree of widget_value objects
1352 representing the panes and items
1353 in menu_items starting at index START, up to index END. */
1355 static widget_value
*
1356 digest_single_submenu (start
, end
, top_level_items
)
1357 int start
, end
, top_level_items
;
1359 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1361 int submenu_depth
= 0;
1362 widget_value
**submenu_stack
;
1366 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1367 wv
= xmalloc_widget_value ();
1371 wv
->button_type
= BUTTON_TYPE_NONE
;
1377 /* Loop over all panes and items made by the preceding call
1378 to parse_single_submenu and construct a tree of widget_value objects.
1379 Ignore the panes and items used by previous calls to
1380 digest_single_submenu, even though those are also in menu_items. */
1384 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1386 submenu_stack
[submenu_depth
++] = save_wv
;
1391 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1394 save_wv
= submenu_stack
[--submenu_depth
];
1397 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1398 && submenu_depth
!= 0)
1399 i
+= MENU_ITEMS_PANE_LENGTH
;
1400 /* Ignore a nil in the item list.
1401 It's meaningful only for dialog boxes. */
1402 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1404 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1406 /* Create a new pane. */
1407 Lisp_Object pane_name
, prefix
;
1412 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1413 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1415 #ifndef HAVE_MULTILINGUAL_MENU
1416 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1418 pane_name
= ENCODE_MENU_STRING (pane_name
);
1419 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1422 pane_string
= (NILP (pane_name
)
1423 ? "" : (char *) SDATA (pane_name
));
1424 /* If there is just one top-level pane, put all its items directly
1425 under the top-level menu. */
1426 if (menu_items_n_panes
== 1)
1429 /* If the pane has a meaningful name,
1430 make the pane a top-level menu item
1431 with its items as a submenu beneath it. */
1432 if (strcmp (pane_string
, ""))
1434 wv
= xmalloc_widget_value ();
1438 first_wv
->contents
= wv
;
1439 wv
->lname
= pane_name
;
1440 /* Set value to 1 so update_submenu_strings can handle '@' */
1441 wv
->value
= (char *)1;
1443 wv
->button_type
= BUTTON_TYPE_NONE
;
1451 i
+= MENU_ITEMS_PANE_LENGTH
;
1455 /* Create a new item within current pane. */
1456 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1459 /* All items should be contained in panes. */
1460 if (panes_seen
== 0)
1463 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1464 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1465 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1466 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1467 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1468 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1469 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1471 #ifndef HAVE_MULTILINGUAL_MENU
1472 if (STRING_MULTIBYTE (item_name
))
1474 item_name
= ENCODE_MENU_STRING (item_name
);
1475 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1478 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1480 descrip
= ENCODE_MENU_STRING (descrip
);
1481 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1483 #endif /* not HAVE_MULTILINGUAL_MENU */
1485 wv
= xmalloc_widget_value ();
1489 save_wv
->contents
= wv
;
1491 wv
->lname
= item_name
;
1492 if (!NILP (descrip
))
1495 /* The EMACS_INT cast avoids a warning. There's no problem
1496 as long as pointers have enough bits to hold small integers. */
1497 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1498 wv
->enabled
= !NILP (enable
);
1501 wv
->button_type
= BUTTON_TYPE_NONE
;
1502 else if (EQ (type
, QCradio
))
1503 wv
->button_type
= BUTTON_TYPE_RADIO
;
1504 else if (EQ (type
, QCtoggle
))
1505 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1509 wv
->selected
= !NILP (selected
);
1510 if (! STRINGP (help
))
1517 i
+= MENU_ITEMS_ITEM_LENGTH
;
1521 /* If we have just one "menu item"
1522 that was originally a button, return it by itself. */
1523 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1525 wv
= first_wv
->contents
;
1526 free_widget_value (first_wv
);
1533 /* Walk through the widget_value tree starting at FIRST_WV and update
1534 the char * pointers from the corresponding lisp values.
1535 We do this after building the whole tree, since GC may happen while the
1536 tree is constructed, and small strings are relocated. So we must wait
1537 until no GC can happen before storing pointers into lisp values. */
1539 update_submenu_strings (first_wv
)
1540 widget_value
*first_wv
;
1544 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1546 if (STRINGP (wv
->lname
))
1548 wv
->name
= SDATA (wv
->lname
);
1550 /* Ignore the @ that means "separate pane".
1551 This is a kludge, but this isn't worth more time. */
1552 if (wv
->value
== (char *)1)
1554 if (wv
->name
[0] == '@')
1560 if (STRINGP (wv
->lkey
))
1561 wv
->key
= SDATA (wv
->lkey
);
1564 update_submenu_strings (wv
->contents
);
1569 #if TARGET_API_MAC_CARBON
1570 extern Lisp_Object Vshow_help_function
;
1573 restore_show_help_function (old_show_help_function
)
1574 Lisp_Object old_show_help_function
;
1576 Vshow_help_function
= old_show_help_function
;
1581 static pascal OSStatus
1582 menu_target_item_handler (next_handler
, event
, data
)
1583 EventHandlerCallRef next_handler
;
1587 OSStatus err
, result
;
1589 MenuItemIndex menu_item
;
1592 int specpdl_count
= SPECPDL_INDEX ();
1594 result
= CallNextEventHandler (next_handler
, event
);
1596 err
= GetEventParameter (event
, kEventParamDirectObject
, typeMenuRef
,
1597 NULL
, sizeof (MenuRef
), NULL
, &menu
);
1599 err
= GetEventParameter (event
, kEventParamMenuItemIndex
,
1600 typeMenuItemIndex
, NULL
,
1601 sizeof (MenuItemIndex
), NULL
, &menu_item
);
1603 err
= GetMenuItemProperty (menu
, menu_item
,
1604 MAC_EMACS_CREATOR_CODE
, 'help',
1605 sizeof (Lisp_Object
), NULL
, &help
);
1609 /* Temporarily bind Vshow_help_function to Qnil because we don't
1610 want tooltips during menu tracking. */
1611 record_unwind_protect (restore_show_help_function
, Vshow_help_function
);
1612 Vshow_help_function
= Qnil
;
1614 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
1616 unbind_to (specpdl_count
, Qnil
);
1618 return err
== noErr
? noErr
: result
;
1623 install_menu_target_item_handler (window
)
1626 OSStatus err
= noErr
;
1627 #if TARGET_API_MAC_CARBON
1628 static const EventTypeSpec specs
[] =
1629 {{kEventClassMenu
, kEventMenuTargetItem
}};
1630 static EventHandlerUPP menu_target_item_handlerUPP
= NULL
;
1632 if (menu_target_item_handlerUPP
== NULL
)
1633 menu_target_item_handlerUPP
=
1634 NewEventHandlerUPP (menu_target_item_handler
);
1636 err
= InstallWindowEventHandler (window
, menu_target_item_handlerUPP
,
1637 GetEventTypeCount (specs
), specs
,
1643 /* Event handler function that pops down a menu on C-g. We can only pop
1644 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1646 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1647 static pascal OSStatus
1648 menu_quit_handler (nextHandler
, theEvent
, userData
)
1649 EventHandlerCallRef nextHandler
;
1655 UInt32 keyModifiers
;
1657 err
= GetEventParameter (theEvent
, kEventParamKeyCode
,
1658 typeUInt32
, NULL
, sizeof(UInt32
), NULL
, &keyCode
);
1661 err
= GetEventParameter (theEvent
, kEventParamKeyModifiers
,
1662 typeUInt32
, NULL
, sizeof(UInt32
),
1663 NULL
, &keyModifiers
);
1665 if (err
== noErr
&& mac_quit_char_key_p (keyModifiers
, keyCode
))
1667 MenuRef menu
= userData
!= 0
1668 ? (MenuRef
)userData
: AcquireRootMenu ();
1670 CancelMenuTracking (menu
, true, 0);
1671 if (!userData
) ReleaseMenu (menu
);
1675 return CallNextEventHandler (nextHandler
, theEvent
);
1677 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1679 /* Add event handler to all menus that belong to KIND so we can detect C-g.
1680 MENU_HANDLE is the root menu of the tracking session to dismiss
1681 when C-g is detected. NULL means the menu bar.
1682 If CancelMenuTracking isn't available, do nothing. */
1685 install_menu_quit_handler (kind
, menu_handle
)
1686 enum mac_menu_kind kind
;
1687 MenuHandle menu_handle
;
1689 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1690 static const EventTypeSpec typesList
[] =
1691 {{kEventClassKeyboard
, kEventRawKeyDown
}};
1694 #if MAC_OS_X_VERSION_MIN_REQUIRED == 1020
1695 if (CancelMenuTracking
== NULL
)
1698 for (id
= min_menu_id
[kind
]; id
< min_menu_id
[kind
+ 1]; id
++)
1700 MenuHandle menu
= GetMenuHandle (id
);
1704 InstallMenuEventHandler (menu
, menu_quit_handler
,
1705 GetEventTypeCount (typesList
),
1706 typesList
, menu_handle
, NULL
);
1708 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1711 /* Set the contents of the menubar widgets of frame F.
1712 The argument FIRST_TIME is currently ignored;
1713 it is set the first time this is called, from initialize_frame_menubar. */
1716 set_frame_menubar (f
, first_time
, deep_p
)
1721 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1723 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1725 int *submenu_start
, *submenu_end
;
1726 int *submenu_top_level_items
, *submenu_n_panes
;
1728 XSETFRAME (Vmenu_updating_frame
, f
);
1730 if (! menubar_widget
)
1732 else if (pending_menu_activation
&& !deep_p
)
1737 /* Make a widget-value tree representing the entire menu trees. */
1739 struct buffer
*prev
= current_buffer
;
1741 int specpdl_count
= SPECPDL_INDEX ();
1742 int previous_menu_items_used
= f
->menu_bar_items_used
;
1743 Lisp_Object
*previous_items
1744 = (Lisp_Object
*) alloca (previous_menu_items_used
1745 * sizeof (Lisp_Object
));
1747 /* If we are making a new widget, its contents are empty,
1748 do always reinitialize them. */
1749 if (! menubar_widget
)
1750 previous_menu_items_used
= 0;
1752 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1753 specbind (Qinhibit_quit
, Qt
);
1754 /* Don't let the debugger step into this code
1755 because it is not reentrant. */
1756 specbind (Qdebug_on_next_call
, Qnil
);
1758 record_unwind_save_match_data ();
1759 if (NILP (Voverriding_local_map_menu_flag
))
1761 specbind (Qoverriding_terminal_local_map
, Qnil
);
1762 specbind (Qoverriding_local_map
, Qnil
);
1765 set_buffer_internal_1 (XBUFFER (buffer
));
1767 /* Run the Lucid hook. */
1768 safe_run_hooks (Qactivate_menubar_hook
);
1770 /* If it has changed current-menubar from previous value,
1771 really recompute the menubar from the value. */
1772 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1773 call0 (Qrecompute_lucid_menubar
);
1774 safe_run_hooks (Qmenu_bar_update_hook
);
1775 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1777 items
= FRAME_MENU_BAR_ITEMS (f
);
1779 /* Save the frame's previous menu bar contents data. */
1780 if (previous_menu_items_used
)
1781 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1782 previous_menu_items_used
* sizeof (Lisp_Object
));
1784 /* Fill in menu_items with the current menu bar contents.
1785 This can evaluate Lisp code. */
1788 menu_items
= f
->menu_bar_vector
;
1789 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1790 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1791 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1792 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1793 submenu_top_level_items
1794 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1796 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1798 Lisp_Object key
, string
, maps
;
1802 key
= XVECTOR (items
)->contents
[i
];
1803 string
= XVECTOR (items
)->contents
[i
+ 1];
1804 maps
= XVECTOR (items
)->contents
[i
+ 2];
1808 submenu_start
[i
] = menu_items_used
;
1810 menu_items_n_panes
= 0;
1811 submenu_top_level_items
[i
]
1812 = parse_single_submenu (key
, string
, maps
);
1813 submenu_n_panes
[i
] = menu_items_n_panes
;
1815 submenu_end
[i
] = menu_items_used
;
1818 finish_menu_items ();
1820 /* Convert menu_items into widget_value trees
1821 to display the menu. This cannot evaluate Lisp code. */
1823 wv
= xmalloc_widget_value ();
1824 wv
->name
= "menubar";
1827 wv
->button_type
= BUTTON_TYPE_NONE
;
1831 for (i
= 0; i
< last_i
; i
+= 4)
1833 menu_items_n_panes
= submenu_n_panes
[i
];
1834 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1835 submenu_top_level_items
[i
]);
1839 first_wv
->contents
= wv
;
1840 /* Don't set wv->name here; GC during the loop might relocate it. */
1842 wv
->button_type
= BUTTON_TYPE_NONE
;
1846 set_buffer_internal_1 (prev
);
1848 /* If there has been no change in the Lisp-level contents
1849 of the menu bar, skip redisplaying it. Just exit. */
1851 /* Compare the new menu items with the ones computed last time. */
1852 for (i
= 0; i
< previous_menu_items_used
; i
++)
1853 if (menu_items_used
== i
1854 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1856 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1858 /* The menu items have not changed. Don't bother updating
1859 the menus in any form, since it would be a no-op. */
1860 free_menubar_widget_value_tree (first_wv
);
1861 discard_menu_items ();
1862 unbind_to (specpdl_count
, Qnil
);
1866 /* The menu items are different, so store them in the frame. */
1867 f
->menu_bar_vector
= menu_items
;
1868 f
->menu_bar_items_used
= menu_items_used
;
1870 /* This calls restore_menu_items to restore menu_items, etc.,
1871 as they were outside. */
1872 unbind_to (specpdl_count
, Qnil
);
1874 /* Now GC cannot happen during the lifetime of the widget_value,
1875 so it's safe to store data from a Lisp_String. */
1876 wv
= first_wv
->contents
;
1877 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1880 string
= XVECTOR (items
)->contents
[i
+ 1];
1883 wv
->name
= (char *) SDATA (string
);
1884 update_submenu_strings (wv
->contents
);
1891 /* Make a widget-value tree containing
1892 just the top level menu bar strings. */
1894 wv
= xmalloc_widget_value ();
1895 wv
->name
= "menubar";
1898 wv
->button_type
= BUTTON_TYPE_NONE
;
1902 items
= FRAME_MENU_BAR_ITEMS (f
);
1903 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1907 string
= XVECTOR (items
)->contents
[i
+ 1];
1911 wv
= xmalloc_widget_value ();
1912 wv
->name
= (char *) SDATA (string
);
1915 wv
->button_type
= BUTTON_TYPE_NONE
;
1917 /* This prevents lwlib from assuming this
1918 menu item is really supposed to be empty. */
1919 /* The EMACS_INT cast avoids a warning.
1920 This value just has to be different from small integers. */
1921 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1926 first_wv
->contents
= wv
;
1930 /* Forget what we thought we knew about what is in the
1931 detailed contents of the menu bar menus.
1932 Changing the top level always destroys the contents. */
1933 f
->menu_bar_items_used
= 0;
1936 /* Create or update the menu bar widget. */
1940 /* Non-null value to indicate menubar has already been "created". */
1941 f
->output_data
.mac
->menubar_widget
= 1;
1943 fill_menubar (first_wv
->contents
, deep_p
);
1945 /* Add event handler so we can detect C-g. */
1946 install_menu_quit_handler (MAC_MENU_MENU_BAR
, NULL
);
1947 install_menu_quit_handler (MAC_MENU_MENU_BAR_SUB
, NULL
);
1948 free_menubar_widget_value_tree (first_wv
);
1953 /* Get rid of the menu bar of frame F, and free its storage.
1954 This is used when deleting a frame, and when turning off the menu bar. */
1957 free_frame_menubar (f
)
1960 f
->output_data
.mac
->menubar_widget
= 0;
1968 struct Lisp_Save_Value
*p
= XSAVE_VALUE (arg
);
1969 FRAME_PTR f
= p
->pointer
;
1970 MenuHandle menu
= GetMenuHandle (min_menu_id
[MAC_MENU_POPUP
]);
1974 /* Must reset this manually because the button release event is not
1975 passed to Emacs event loop. */
1976 FRAME_MAC_DISPLAY_INFO (f
)->grabbed
= 0;
1978 /* delete all menus */
1979 dispose_menus (MAC_MENU_POPUP_SUB
, 0);
1980 DeleteMenu (min_menu_id
[MAC_MENU_POPUP
]);
1988 /* Mac_menu_show actually displays a menu using the panes and items in
1989 menu_items and returns the value selected from it; we assume input
1990 is blocked by the caller. */
1992 /* F is the frame the menu is for.
1993 X and Y are the frame-relative specified position,
1994 relative to the inside upper left corner of the frame F.
1995 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1996 KEYMAPS is 1 if this menu was specified with keymaps;
1997 in that case, we return a list containing the chosen item's value
1998 and perhaps also the pane's prefix.
1999 TITLE is the specified menu title.
2000 ERROR is a place to store an error message string in case of failure.
2001 (We return nil on failure, but the value doesn't actually matter.) */
2004 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
2015 int menu_item_choice
;
2016 int menu_item_selection
;
2019 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
2020 widget_value
**submenu_stack
2021 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
2022 Lisp_Object
*subprefix_stack
2023 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
2024 int submenu_depth
= 0;
2027 int specpdl_count
= SPECPDL_INDEX ();
2031 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
2033 *error
= "Empty menu";
2037 /* Create a tree of widget_value objects
2038 representing the panes and their items. */
2039 wv
= xmalloc_widget_value ();
2043 wv
->button_type
= BUTTON_TYPE_NONE
;
2048 /* Loop over all panes and items, filling in the tree. */
2050 while (i
< menu_items_used
)
2052 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2054 submenu_stack
[submenu_depth
++] = save_wv
;
2060 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2063 save_wv
= submenu_stack
[--submenu_depth
];
2067 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
2068 && submenu_depth
!= 0)
2069 i
+= MENU_ITEMS_PANE_LENGTH
;
2070 /* Ignore a nil in the item list.
2071 It's meaningful only for dialog boxes. */
2072 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2074 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2076 /* Create a new pane. */
2077 Lisp_Object pane_name
, prefix
;
2080 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
2081 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2083 #ifndef HAVE_MULTILINGUAL_MENU
2084 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
2086 pane_name
= ENCODE_MENU_STRING (pane_name
);
2087 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
2090 pane_string
= (NILP (pane_name
)
2091 ? "" : (char *) SDATA (pane_name
));
2092 /* If there is just one top-level pane, put all its items directly
2093 under the top-level menu. */
2094 if (menu_items_n_panes
== 1)
2097 /* If the pane has a meaningful name,
2098 make the pane a top-level menu item
2099 with its items as a submenu beneath it. */
2100 if (!keymaps
&& strcmp (pane_string
, ""))
2102 wv
= xmalloc_widget_value ();
2106 first_wv
->contents
= wv
;
2107 wv
->name
= pane_string
;
2108 if (keymaps
&& !NILP (prefix
))
2112 wv
->button_type
= BUTTON_TYPE_NONE
;
2117 else if (first_pane
)
2123 i
+= MENU_ITEMS_PANE_LENGTH
;
2127 /* Create a new item within current pane. */
2128 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
2129 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2130 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2131 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2132 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
2133 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
2134 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
2135 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2137 #ifndef HAVE_MULTILINGUAL_MENU
2138 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
2140 item_name
= ENCODE_MENU_STRING (item_name
);
2141 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
2144 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
2146 descrip
= ENCODE_MENU_STRING (descrip
);
2147 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
2149 #endif /* not HAVE_MULTILINGUAL_MENU */
2151 wv
= xmalloc_widget_value ();
2155 save_wv
->contents
= wv
;
2156 wv
->name
= (char *) SDATA (item_name
);
2157 if (!NILP (descrip
))
2158 wv
->key
= (char *) SDATA (descrip
);
2160 /* Use the contents index as call_data, since we are
2161 restricted to 16-bits. */
2162 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
2163 wv
->enabled
= !NILP (enable
);
2166 wv
->button_type
= BUTTON_TYPE_NONE
;
2167 else if (EQ (type
, QCtoggle
))
2168 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
2169 else if (EQ (type
, QCradio
))
2170 wv
->button_type
= BUTTON_TYPE_RADIO
;
2174 wv
->selected
= !NILP (selected
);
2176 if (! STRINGP (help
))
2183 i
+= MENU_ITEMS_ITEM_LENGTH
;
2187 /* Deal with the title, if it is non-nil. */
2190 widget_value
*wv_title
= xmalloc_widget_value ();
2191 widget_value
*wv_sep
= xmalloc_widget_value ();
2193 /* Maybe replace this separator with a bitmap or owner-draw item
2194 so that it looks better. Having two separators looks odd. */
2195 wv_sep
->name
= "--";
2196 wv_sep
->next
= first_wv
->contents
;
2197 wv_sep
->help
= Qnil
;
2199 #ifndef HAVE_MULTILINGUAL_MENU
2200 if (STRING_MULTIBYTE (title
))
2201 title
= ENCODE_MENU_STRING (title
);
2204 wv_title
->name
= (char *) SDATA (title
);
2205 wv_title
->enabled
= FALSE
;
2206 wv_title
->title
= TRUE
;
2207 wv_title
->button_type
= BUTTON_TYPE_NONE
;
2208 wv_title
->help
= Qnil
;
2209 wv_title
->next
= wv_sep
;
2210 first_wv
->contents
= wv_title
;
2213 /* Actually create the menu. */
2214 menu
= NewMenu (min_menu_id
[MAC_MENU_POPUP
], "\p");
2215 InsertMenu (menu
, -1);
2216 fill_menu (menu
, first_wv
->contents
, MAC_MENU_POPUP_SUB
,
2217 min_menu_id
[MAC_MENU_POPUP_SUB
]);
2219 /* Free the widget_value objects we used to specify the
2221 free_menubar_widget_value_tree (first_wv
);
2223 /* Adjust coordinates to be root-window-relative. */
2227 SetPortWindowPort (FRAME_MAC_WINDOW (f
));
2228 LocalToGlobal (&pos
);
2230 /* No selection has been chosen yet. */
2231 menu_item_choice
= 0;
2232 menu_item_selection
= 0;
2234 record_unwind_protect (pop_down_menu
, make_save_value (f
, 0));
2236 /* Add event handler so we can detect C-g. */
2237 install_menu_quit_handler (MAC_MENU_POPUP
, menu
);
2238 install_menu_quit_handler (MAC_MENU_POPUP_SUB
, menu
);
2240 /* Display the menu. */
2241 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
2242 menu_item_selection
= LoWord (menu_item_choice
);
2244 /* Get the refcon to find the correct item */
2245 if (menu_item_selection
)
2247 MenuHandle sel_menu
= GetMenuHandle (HiWord (menu_item_choice
));
2249 GetMenuItemRefCon (sel_menu
, menu_item_selection
, &refcon
);
2252 else if (! for_click
)
2253 /* Make "Cancel" equivalent to C-g unless this menu was popped up by
2255 Fsignal (Qquit
, Qnil
);
2257 /* Find the selected item, and its pane, to return
2258 the proper value. */
2259 if (menu_item_selection
!= 0)
2261 Lisp_Object prefix
, entry
;
2263 prefix
= entry
= Qnil
;
2265 while (i
< menu_items_used
)
2267 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
2269 subprefix_stack
[submenu_depth
++] = prefix
;
2273 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
2275 prefix
= subprefix_stack
[--submenu_depth
];
2278 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2281 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2282 i
+= MENU_ITEMS_PANE_LENGTH
;
2284 /* Ignore a nil in the item list.
2285 It's meaningful only for dialog boxes. */
2286 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2291 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2292 if ((int) (EMACS_INT
) refcon
== i
)
2298 entry
= Fcons (entry
, Qnil
);
2300 entry
= Fcons (prefix
, entry
);
2301 for (j
= submenu_depth
- 1; j
>= 0; j
--)
2302 if (!NILP (subprefix_stack
[j
]))
2303 entry
= Fcons (subprefix_stack
[j
], entry
);
2307 i
+= MENU_ITEMS_ITEM_LENGTH
;
2311 else if (!for_click
)
2312 /* Make "Cancel" equivalent to C-g. */
2313 Fsignal (Qquit
, Qnil
);
2315 unbind_to (specpdl_count
, Qnil
);
2322 /* Construct native Mac OS menubar based on widget_value tree. */
2325 mac_dialog (widget_value
*wv
)
2329 char **button_labels
;
2336 WindowPtr window_ptr
;
2339 EventRecord event_record
;
2341 int control_part_code
;
2344 dialog_name
= wv
->name
;
2345 nb_buttons
= dialog_name
[1] - '0';
2346 left_count
= nb_buttons
- (dialog_name
[4] - '0');
2347 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
2348 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
2351 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
2352 strcpy (prompt
, wv
->value
);
2356 for (i
= 0; i
< nb_buttons
; i
++)
2358 button_labels
[i
] = wv
->value
;
2359 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
2360 strcpy (button_labels
[i
], wv
->value
);
2361 c2pstr (button_labels
[i
]);
2362 ref_cons
[i
] = (UInt32
) wv
->call_data
;
2366 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
2368 SetPortWindowPort (window_ptr
);
2371 /* Left and right margins in the dialog are 13 pixels each.*/
2373 /* Calculate width of dialog box: 8 pixels on each side of the text
2374 label in each button, 12 pixels between buttons. */
2375 for (i
= 0; i
< nb_buttons
; i
++)
2376 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
2378 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
2381 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
2383 SizeWindow (window_ptr
, dialog_width
, 78, 0);
2384 ShowWindow (window_ptr
);
2386 SetPortWindowPort (window_ptr
);
2391 DrawString (prompt
);
2394 for (i
= 0; i
< nb_buttons
; i
++)
2396 int button_width
= StringWidth (button_labels
[i
]) + 16;
2397 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
2398 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
2399 kControlPushButtonProc
, ref_cons
[i
]);
2400 left
+= button_width
+ 12;
2401 if (i
== left_count
- 1)
2408 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
2409 if (event_record
.what
== mouseDown
)
2411 part_code
= FindWindow (event_record
.where
, &window_ptr
);
2412 if (part_code
== inContent
)
2414 mouse
= event_record
.where
;
2415 GlobalToLocal (&mouse
);
2416 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2417 if (control_part_code
== kControlButtonPart
)
2418 if (TrackControl (ch
, mouse
, NULL
))
2419 i
= GetControlReference (ch
);
2424 DisposeWindow (window_ptr
);
2429 static char * button_names
[] = {
2430 "button1", "button2", "button3", "button4", "button5",
2431 "button6", "button7", "button8", "button9", "button10" };
2434 mac_dialog_show (f
, keymaps
, title
, header
, error_name
)
2437 Lisp_Object title
, header
;
2440 int i
, nb_buttons
=0;
2441 char dialog_name
[6];
2442 int menu_item_selection
;
2444 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2446 /* Number of elements seen so far, before boundary. */
2448 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2449 int boundary_seen
= 0;
2453 if (menu_items_n_panes
> 1)
2455 *error_name
= "Multiple panes in dialog box";
2459 /* Create a tree of widget_value objects
2460 representing the text label and buttons. */
2462 Lisp_Object pane_name
, prefix
;
2464 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2465 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2466 pane_string
= (NILP (pane_name
)
2467 ? "" : (char *) SDATA (pane_name
));
2468 prev_wv
= xmalloc_widget_value ();
2469 prev_wv
->value
= pane_string
;
2470 if (keymaps
&& !NILP (prefix
))
2472 prev_wv
->enabled
= 1;
2473 prev_wv
->name
= "message";
2474 prev_wv
->help
= Qnil
;
2477 /* Loop over all panes and items, filling in the tree. */
2478 i
= MENU_ITEMS_PANE_LENGTH
;
2479 while (i
< menu_items_used
)
2482 /* Create a new item within current pane. */
2483 Lisp_Object item_name
, enable
, descrip
;
2484 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2485 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2487 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2489 if (NILP (item_name
))
2491 free_menubar_widget_value_tree (first_wv
);
2492 *error_name
= "Submenu in dialog items";
2495 if (EQ (item_name
, Qquote
))
2497 /* This is the boundary between left-side elts
2498 and right-side elts. Stop incrementing right_count. */
2503 if (nb_buttons
>= 9)
2505 free_menubar_widget_value_tree (first_wv
);
2506 *error_name
= "Too many dialog items";
2510 wv
= xmalloc_widget_value ();
2512 wv
->name
= (char *) button_names
[nb_buttons
];
2513 if (!NILP (descrip
))
2514 wv
->key
= (char *) SDATA (descrip
);
2515 wv
->value
= (char *) SDATA (item_name
);
2516 wv
->call_data
= (void *) i
;
2517 /* menu item is identified by its index in menu_items table */
2518 wv
->enabled
= !NILP (enable
);
2522 if (! boundary_seen
)
2526 i
+= MENU_ITEMS_ITEM_LENGTH
;
2529 /* If the boundary was not specified,
2530 by default put half on the left and half on the right. */
2531 if (! boundary_seen
)
2532 left_count
= nb_buttons
- nb_buttons
/ 2;
2534 wv
= xmalloc_widget_value ();
2535 wv
->name
= dialog_name
;
2538 /* Frame title: 'Q' = Question, 'I' = Information.
2539 Can also have 'E' = Error if, one day, we want
2540 a popup for errors. */
2542 dialog_name
[0] = 'Q';
2544 dialog_name
[0] = 'I';
2546 /* Dialog boxes use a really stupid name encoding
2547 which specifies how many buttons to use
2548 and how many buttons are on the right. */
2549 dialog_name
[1] = '0' + nb_buttons
;
2550 dialog_name
[2] = 'B';
2551 dialog_name
[3] = 'R';
2552 /* Number of buttons to put on the right. */
2553 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2555 wv
->contents
= first_wv
;
2559 /* Actually create the dialog. */
2561 menu_item_selection
= mac_dialog (first_wv
);
2563 menu_item_selection
= 0;
2566 /* Free the widget_value objects we used to specify the contents. */
2567 free_menubar_widget_value_tree (first_wv
);
2569 /* Find the selected item, and its pane, to return
2570 the proper value. */
2571 if (menu_item_selection
!= 0)
2577 while (i
< menu_items_used
)
2581 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2584 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2585 i
+= MENU_ITEMS_PANE_LENGTH
;
2587 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2589 /* This is the boundary between left-side elts and
2596 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2597 if (menu_item_selection
== i
)
2601 entry
= Fcons (entry
, Qnil
);
2603 entry
= Fcons (prefix
, entry
);
2607 i
+= MENU_ITEMS_ITEM_LENGTH
;
2612 /* Make "Cancel" equivalent to C-g. */
2613 Fsignal (Qquit
, Qnil
);
2617 #endif /* HAVE_DIALOGS */
2620 /* Is this item a separator? */
2622 name_is_separator (name
)
2625 const char *start
= name
;
2627 /* Check if name string consists of only dashes ('-'). */
2628 while (*name
== '-') name
++;
2629 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2630 or "--deep-shadow". We don't implement them yet, se we just treat
2631 them like normal separators. */
2632 return (*name
== '\0' || start
+ 2 == name
);
2636 add_menu_item (menu
, pos
, wv
)
2641 #if TARGET_API_MAC_CARBON
2642 CFStringRef item_name
;
2647 if (name_is_separator (wv
->name
))
2648 AppendMenu (menu
, "\p-");
2651 AppendMenu (menu
, "\pX");
2653 #if TARGET_API_MAC_CARBON
2654 item_name
= cfstring_create_with_utf8_cstring (wv
->name
);
2656 if (wv
->key
!= NULL
)
2658 CFStringRef name
, key
;
2661 key
= cfstring_create_with_utf8_cstring (wv
->key
);
2662 item_name
= CFStringCreateWithFormat (NULL
, NULL
, CFSTR ("%@ %@"),
2668 SetMenuItemTextWithCFString (menu
, pos
, item_name
);
2669 CFRelease (item_name
);
2672 EnableMenuItem (menu
, pos
);
2674 DisableMenuItem (menu
, pos
);
2676 if (STRINGP (wv
->help
))
2677 SetMenuItemProperty (menu
, pos
, MAC_EMACS_CREATOR_CODE
, 'help',
2678 sizeof (Lisp_Object
), &wv
->help
);
2679 #else /* ! TARGET_API_MAC_CARBON */
2680 item_name
[sizeof (item_name
) - 1] = '\0';
2681 strncpy (item_name
, wv
->name
, sizeof (item_name
) - 1);
2682 if (wv
->key
!= NULL
)
2684 int len
= strlen (item_name
);
2686 strncpy (item_name
+ len
, " ", sizeof (item_name
) - 1 - len
);
2687 len
= strlen (item_name
);
2688 strncpy (item_name
+ len
, wv
->key
, sizeof (item_name
) - 1 - len
);
2691 SetMenuItemText (menu
, pos
, item_name
);
2694 EnableItem (menu
, pos
);
2696 DisableItem (menu
, pos
);
2697 #endif /* ! TARGET_API_MAC_CARBON */
2699 /* Draw radio buttons and tickboxes. */
2700 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2701 wv
->button_type
== BUTTON_TYPE_RADIO
))
2702 SetItemMark (menu
, pos
, checkMark
);
2704 SetItemMark (menu
, pos
, noMark
);
2706 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2710 /* Construct native Mac OS menu based on widget_value tree. */
2713 fill_menu (menu
, wv
, kind
, submenu_id
)
2716 enum mac_menu_kind kind
;
2721 for (pos
= 1; wv
!= NULL
; wv
= wv
->next
, pos
++)
2723 add_menu_item (menu
, pos
, wv
);
2724 if (wv
->contents
&& submenu_id
< min_menu_id
[kind
+ 1])
2726 MenuHandle submenu
= NewMenu (submenu_id
, "\pX");
2728 InsertMenu (submenu
, -1);
2729 SetMenuItemHierarchicalID (menu
, pos
, submenu_id
);
2730 submenu_id
= fill_menu (submenu
, wv
->contents
, kind
, submenu_id
+ 1);
2737 /* Construct native Mac OS menubar based on widget_value tree. */
2740 fill_menubar (wv
, deep_p
)
2747 #if !TARGET_API_MAC_CARBON
2748 int title_changed_p
= 0;
2751 /* Clean up the menu bar when filled by the entire menu trees. */
2754 dispose_menus (MAC_MENU_MENU_BAR
, 0);
2755 dispose_menus (MAC_MENU_MENU_BAR_SUB
, 0);
2756 #if !TARGET_API_MAC_CARBON
2757 title_changed_p
= 1;
2761 /* Fill menu bar titles and submenus. Reuse the existing menu bar
2762 titles as much as possible to minimize redraw (if !deep_p). */
2763 submenu_id
= min_menu_id
[MAC_MENU_MENU_BAR_SUB
];
2764 for (id
= min_menu_id
[MAC_MENU_MENU_BAR
];
2765 wv
!= NULL
&& id
< min_menu_id
[MAC_MENU_MENU_BAR
+ 1];
2766 wv
= wv
->next
, id
++)
2768 strncpy (title
, wv
->name
, 255);
2772 menu
= GetMenuHandle (id
);
2775 #if TARGET_API_MAC_CARBON
2778 GetMenuTitle (menu
, old_title
);
2779 if (!EqualString (title
, old_title
, false, false))
2780 SetMenuTitle (menu
, title
);
2781 #else /* !TARGET_API_MAC_CARBON */
2782 if (!EqualString (title
, (*menu
)->menuData
, false, false))
2786 menu
= NewMenu (id
, title
);
2787 InsertMenu (menu
, GetMenuHandle (id
+ 1) ? id
+ 1 : 0);
2788 title_changed_p
= 1;
2790 #endif /* !TARGET_API_MAC_CARBON */
2794 menu
= NewMenu (id
, title
);
2795 InsertMenu (menu
, 0);
2796 #if !TARGET_API_MAC_CARBON
2797 title_changed_p
= 1;
2802 submenu_id
= fill_menu (menu
, wv
->contents
, MAC_MENU_MENU_BAR_SUB
,
2806 if (id
< min_menu_id
[MAC_MENU_MENU_BAR
+ 1] && GetMenuHandle (id
))
2808 dispose_menus (MAC_MENU_MENU_BAR
, id
);
2809 #if !TARGET_API_MAC_CARBON
2810 title_changed_p
= 1;
2814 #if !TARGET_API_MAC_CARBON
2815 if (title_changed_p
)
2820 /* Dispose of menus that belong to KIND, and remove them from the menu
2821 list. ID is the lower bound of menu IDs that will be processed. */
2824 dispose_menus (kind
, id
)
2825 enum mac_menu_kind kind
;
2828 for (id
= max (id
, min_menu_id
[kind
]); id
< min_menu_id
[kind
+ 1]; id
++)
2830 MenuHandle menu
= GetMenuHandle (id
);
2839 #endif /* HAVE_MENUS */
2841 /* The following is used by delayed window autoselection. */
2843 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2844 doc
: /* Return t if a menu or popup dialog is active. */)
2847 /* Always return Qnil since menu selection functions do not return
2848 until a selection has been made or cancelled. */
2855 staticpro (&menu_items
);
2858 Qdebug_on_next_call
= intern ("debug-on-next-call");
2859 staticpro (&Qdebug_on_next_call
);
2861 defsubr (&Sx_popup_menu
);
2862 defsubr (&Smenu_or_popup_active_p
);
2864 defsubr (&Sx_popup_dialog
);
2868 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2869 (do not change this comment) */