1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
29 #include "termhooks.h"
34 #include "blockinput.h"
39 /* This may include sys/types.h, and that somehow loses
40 if this is not done before the other system files. */
43 /* Load sys/types.h if not already loaded.
44 In some systems loading it twice is suicidal. */
46 #include <sys/types.h>
49 #include "dispextern.h"
51 #if TARGET_API_MAC_CARBON
52 #define HAVE_DIALOGS 1
55 #undef HAVE_MULTILINGUAL_MENU
57 /******************************************************************/
59 /* Assumed by other routines to zero area returned. */
60 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
61 0, (sizeof (widget_value)))
62 #define free_widget_value(wv) xfree (wv)
64 /******************************************************************/
71 Lisp_Object Qdebug_on_next_call
;
73 extern Lisp_Object Vmenu_updating_frame
;
75 extern Lisp_Object Qmenu_bar
, Qmac_apple_event
;
77 extern Lisp_Object QCtoggle
, QCradio
;
79 extern Lisp_Object Voverriding_local_map
;
80 extern Lisp_Object Voverriding_local_map_menu_flag
;
82 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
84 extern Lisp_Object Qmenu_bar_update_hook
;
86 void set_frame_menubar
P_ ((FRAME_PTR
, int, int));
88 #if TARGET_API_MAC_CARBON
89 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
91 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
94 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
95 Lisp_Object
, Lisp_Object
, Lisp_Object
,
96 Lisp_Object
, Lisp_Object
));
98 static Lisp_Object mac_dialog_show
P_ ((FRAME_PTR
, int, Lisp_Object
,
99 Lisp_Object
, char **));
101 static Lisp_Object mac_menu_show
P_ ((struct frame
*, int, int, int, int,
102 Lisp_Object
, char **));
103 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
104 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
106 static void list_of_panes
P_ ((Lisp_Object
));
107 static void list_of_items
P_ ((Lisp_Object
));
110 /* This holds a Lisp vector that holds the results of decoding
111 the keymaps or alist-of-alists that specify a menu.
113 It describes the panes and items within the panes.
115 Each pane is described by 3 elements in the vector:
116 t, the pane name, the pane's prefix key.
117 Then follow the pane's items, with 5 elements per item:
118 the item string, the enable flag, the item's value,
119 the definition, and the equivalent keyboard key's description string.
121 In some cases, multiple levels of menus may be described.
122 A single vector slot containing nil indicates the start of a submenu.
123 A single vector slot containing lambda indicates the end of a submenu.
124 The submenu follows a menu item which is the way to reach the submenu.
126 A single vector slot containing quote indicates that the
127 following items should appear on the right of a dialog box.
129 Using a Lisp vector to hold this information while we decode it
130 takes care of protecting all the data from GC. */
132 #define MENU_ITEMS_PANE_NAME 1
133 #define MENU_ITEMS_PANE_PREFIX 2
134 #define MENU_ITEMS_PANE_LENGTH 3
138 MENU_ITEMS_ITEM_NAME
= 0,
139 MENU_ITEMS_ITEM_ENABLE
,
140 MENU_ITEMS_ITEM_VALUE
,
141 MENU_ITEMS_ITEM_EQUIV_KEY
,
142 MENU_ITEMS_ITEM_DEFINITION
,
143 MENU_ITEMS_ITEM_TYPE
,
144 MENU_ITEMS_ITEM_SELECTED
,
145 MENU_ITEMS_ITEM_HELP
,
146 MENU_ITEMS_ITEM_LENGTH
149 static Lisp_Object menu_items
;
151 /* Number of slots currently allocated in menu_items. */
152 static int menu_items_allocated
;
154 /* This is the index in menu_items of the first empty slot. */
155 static int menu_items_used
;
157 /* The number of panes currently recorded in menu_items,
158 excluding those within submenus. */
159 static int menu_items_n_panes
;
161 /* Current depth within submenus. */
162 static int menu_items_submenu_depth
;
164 /* Nonzero means a menu is currently active. */
165 int popup_activated_flag
;
167 /* This is set nonzero after the user activates the menu bar, and set
168 to zero again after the menu bars are redisplayed by prepare_menu_bar.
169 While it is nonzero, all calls to set_frame_menubar go deep.
171 I don't understand why this is needed, but it does seem to be
172 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
174 int pending_menu_activation
;
176 /* Initialize the menu_items structure if we haven't already done so.
177 Also mark it as currently empty. */
182 if (NILP (menu_items
))
184 menu_items_allocated
= 60;
185 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
189 menu_items_n_panes
= 0;
190 menu_items_submenu_depth
= 0;
193 /* Call at the end of generating the data in menu_items. */
200 /* Call when finished using the data for the current menu
204 discard_menu_items ()
206 /* Free the structure if it is especially large.
207 Otherwise, hold on to it, to save time. */
208 if (menu_items_allocated
> 200)
211 menu_items_allocated
= 0;
215 /* This undoes save_menu_items, and it is called by the specpdl unwind
219 restore_menu_items (saved
)
222 menu_items
= XCAR (saved
);
223 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
224 saved
= XCDR (saved
);
225 menu_items_used
= XINT (XCAR (saved
));
226 saved
= XCDR (saved
);
227 menu_items_n_panes
= XINT (XCAR (saved
));
228 saved
= XCDR (saved
);
229 menu_items_submenu_depth
= XINT (XCAR (saved
));
233 /* Push the whole state of menu_items processing onto the specpdl.
234 It will be restored when the specpdl is unwound. */
239 Lisp_Object saved
= list4 (menu_items
,
240 make_number (menu_items_used
),
241 make_number (menu_items_n_panes
),
242 make_number (menu_items_submenu_depth
));
243 record_unwind_protect (restore_menu_items
, saved
);
247 /* Make the menu_items vector twice as large. */
253 int old_size
= menu_items_allocated
;
256 menu_items_allocated
*= 2;
258 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
259 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
260 old_size
* sizeof (Lisp_Object
));
263 /* Begin a submenu. */
266 push_submenu_start ()
268 if (menu_items_used
+ 1 > menu_items_allocated
)
271 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
272 menu_items_submenu_depth
++;
280 if (menu_items_used
+ 1 > menu_items_allocated
)
283 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
284 menu_items_submenu_depth
--;
287 /* Indicate boundary between left and right. */
290 push_left_right_boundary ()
292 if (menu_items_used
+ 1 > menu_items_allocated
)
295 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
298 /* Start a new menu pane in menu_items.
299 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
302 push_menu_pane (name
, prefix_vec
)
303 Lisp_Object name
, prefix_vec
;
305 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
308 if (menu_items_submenu_depth
== 0)
309 menu_items_n_panes
++;
310 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
311 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
312 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
315 /* Push one menu item into the current pane. NAME is the string to
316 display. ENABLE if non-nil means this item can be selected. KEY
317 is the key generated by choosing this item, or nil if this item
318 doesn't really have a definition. DEF is the definition of this
319 item. EQUIV is the textual description of the keyboard equivalent
320 for this item (or nil if none). TYPE is the type of this menu
321 item, one of nil, `toggle' or `radio'. */
324 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
325 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
327 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
330 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
331 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
332 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
333 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
334 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
335 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
336 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
337 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
340 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
341 and generate menu panes for them in menu_items.
342 If NOTREAL is nonzero,
343 don't bother really computing whether an item is enabled. */
346 keymap_panes (keymaps
, nmaps
, notreal
)
347 Lisp_Object
*keymaps
;
355 /* Loop over the given keymaps, making a pane for each map.
356 But don't make a pane that is empty--ignore that map instead.
357 P is the number of panes we have made so far. */
358 for (mapno
= 0; mapno
< nmaps
; mapno
++)
359 single_keymap_panes (keymaps
[mapno
],
360 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
362 finish_menu_items ();
365 /* Args passed between single_keymap_panes and single_menu_item. */
368 Lisp_Object pending_maps
;
369 int maxdepth
, notreal
;
372 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
375 /* This is a recursive subroutine of keymap_panes.
376 It handles one keymap, KEYMAP.
377 The other arguments are passed along
378 or point to local variables of the previous function.
379 If NOTREAL is nonzero, only check for equivalent key bindings, don't
380 evaluate expressions in menu items and don't make any menu.
382 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
385 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
387 Lisp_Object pane_name
;
395 skp
.pending_maps
= Qnil
;
396 skp
.maxdepth
= maxdepth
;
397 skp
.notreal
= notreal
;
402 push_menu_pane (pane_name
, prefix
);
404 GCPRO1 (skp
.pending_maps
);
405 map_keymap (keymap
, single_menu_item
, Qnil
, &skp
, 1);
408 /* Process now any submenus which want to be panes at this level. */
409 while (CONSP (skp
.pending_maps
))
411 Lisp_Object elt
, eltcdr
, string
;
412 elt
= XCAR (skp
.pending_maps
);
414 string
= XCAR (eltcdr
);
415 /* We no longer discard the @ from the beginning of the string here.
416 Instead, we do this in mac_menu_show. */
417 single_keymap_panes (Fcar (elt
), string
,
418 XCDR (eltcdr
), notreal
, maxdepth
- 1);
419 skp
.pending_maps
= XCDR (skp
.pending_maps
);
423 /* This is a subroutine of single_keymap_panes that handles one
425 KEY is a key in a keymap and ITEM is its binding.
426 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
428 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
429 evaluate expressions in menu items and don't make any menu.
430 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
433 single_menu_item (key
, item
, dummy
, skp_v
)
434 Lisp_Object key
, item
, dummy
;
437 Lisp_Object map
, item_string
, enabled
;
438 struct gcpro gcpro1
, gcpro2
;
440 struct skp
*skp
= skp_v
;
442 /* Parse the menu item and leave the result in item_properties. */
444 res
= parse_menu_item (item
, skp
->notreal
, 0);
447 return; /* Not a menu item. */
449 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
453 /* We don't want to make a menu, just traverse the keymaps to
454 precompute equivalent key bindings. */
456 single_keymap_panes (map
, Qnil
, key
, 1, skp
->maxdepth
- 1);
460 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
461 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
463 if (!NILP (map
) && SREF (item_string
, 0) == '@')
466 /* An enabled separate pane. Remember this to handle it later. */
467 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
472 push_menu_item (item_string
, enabled
, key
,
473 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
474 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
475 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
476 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
477 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
479 /* Display a submenu using the toolkit. */
480 if (! (NILP (map
) || NILP (enabled
)))
482 push_submenu_start ();
483 single_keymap_panes (map
, Qnil
, key
, 0, skp
->maxdepth
- 1);
488 /* Push all the panes and items of a menu described by the
489 alist-of-alists MENU.
490 This handles old-fashioned calls to x-popup-menu. */
500 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
502 Lisp_Object elt
, pane_name
, pane_data
;
504 pane_name
= Fcar (elt
);
505 CHECK_STRING (pane_name
);
506 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
507 pane_data
= Fcdr (elt
);
508 CHECK_CONS (pane_data
);
509 list_of_items (pane_data
);
512 finish_menu_items ();
515 /* Push the items in a single pane defined by the alist PANE. */
521 Lisp_Object tail
, item
, item1
;
523 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
527 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
528 Qnil
, Qnil
, Qnil
, Qnil
);
529 else if (CONSP (item
))
532 CHECK_STRING (item1
);
533 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
534 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
537 push_left_right_boundary ();
543 cleanup_popup_menu (arg
)
546 discard_menu_items ();
550 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
551 doc
: /* Pop up a deck-of-cards menu and return user's selection.
552 POSITION is a position specification. This is either a mouse button event
553 or a list ((XOFFSET YOFFSET) WINDOW)
554 where XOFFSET and YOFFSET are positions in pixels from the top left
555 corner of WINDOW. (WINDOW may be a window or a frame object.)
556 This controls the position of the top left of the menu as a whole.
557 If POSITION is t, it means to use the current mouse position.
559 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
560 The menu items come from key bindings that have a menu string as well as
561 a definition; actually, the "definition" in such a key binding looks like
562 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
563 the keymap as a top-level element.
565 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
566 Otherwise, REAL-DEFINITION should be a valid key binding definition.
568 You can also use a list of keymaps as MENU.
569 Then each keymap makes a separate pane.
571 When MENU is a keymap or a list of keymaps, the return value is the
572 list of events corresponding to the user's choice. Note that
573 `x-popup-menu' does not actually execute the command bound to that
576 Alternatively, you can specify a menu of multiple panes
577 with a list of the form (TITLE PANE1 PANE2...),
578 where each pane is a list of form (TITLE ITEM1 ITEM2...).
579 Each ITEM is normally a cons cell (STRING . VALUE);
580 but a string can appear as an item--that makes a nonselectable line
582 With this form of menu, the return value is VALUE from the chosen item.
584 If POSITION is nil, don't display the menu at all, just precalculate the
585 cached information about equivalent key sequences.
587 If the user gets rid of the menu without making a valid choice, for
588 instance by clicking the mouse away from a valid choice or by typing
589 keyboard input, then this normally results in a quit and
590 `x-popup-menu' does not return. But if POSITION is a mouse button
591 event (indicating that the user invoked the menu with the mouse) then
592 no quit occurs and `x-popup-menu' returns nil. */)
594 Lisp_Object position
, menu
;
596 Lisp_Object keymap
, tem
;
597 int xpos
= 0, ypos
= 0;
599 char *error_name
= NULL
;
600 Lisp_Object selection
;
602 Lisp_Object x
, y
, window
;
605 int specpdl_count
= SPECPDL_INDEX ();
609 if (! NILP (position
))
613 /* Decode the first argument: find the window and the coordinates. */
614 if (EQ (position
, Qt
)
615 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
616 || EQ (XCAR (position
), Qtool_bar
)
617 || EQ (XCAR (position
), Qmac_apple_event
))))
619 /* Use the mouse's current position. */
620 FRAME_PTR new_f
= SELECTED_FRAME ();
621 Lisp_Object bar_window
;
622 enum scroll_bar_part part
;
625 if (mouse_position_hook
)
626 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
627 &part
, &x
, &y
, &time
);
629 XSETFRAME (window
, new_f
);
632 window
= selected_window
;
639 tem
= Fcar (position
);
642 window
= Fcar (Fcdr (position
));
644 y
= Fcar (XCDR (tem
));
649 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
650 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
651 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
660 /* Decode where to put the menu. */
668 else if (WINDOWP (window
))
670 CHECK_LIVE_WINDOW (window
);
671 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
673 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
674 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
677 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
678 but I don't want to make one now. */
679 CHECK_WINDOW (window
);
684 XSETFRAME (Vmenu_updating_frame
, f
);
687 Vmenu_updating_frame
= Qnil
;
688 #endif /* HAVE_MENUS */
693 /* Decode the menu items from what was specified. */
695 keymap
= get_keymap (menu
, 0, 0);
698 /* We were given a keymap. Extract menu info from the keymap. */
701 /* Extract the detailed info to make one pane. */
702 keymap_panes (&menu
, 1, NILP (position
));
704 /* Search for a string appearing directly as an element of the keymap.
705 That string is the title of the menu. */
706 prompt
= Fkeymap_prompt (keymap
);
707 if (NILP (title
) && !NILP (prompt
))
710 /* Make that be the pane title of the first pane. */
711 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
712 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
716 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
718 /* We were given a list of keymaps. */
719 int nmaps
= XFASTINT (Flength (menu
));
721 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
726 /* The first keymap that has a prompt string
727 supplies the menu title. */
728 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
732 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
734 prompt
= Fkeymap_prompt (keymap
);
735 if (NILP (title
) && !NILP (prompt
))
739 /* Extract the detailed info to make one pane. */
740 keymap_panes (maps
, nmaps
, NILP (position
));
742 /* Make the title be the pane title of the first pane. */
743 if (!NILP (title
) && menu_items_n_panes
>= 0)
744 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
750 /* We were given an old-fashioned menu. */
752 CHECK_STRING (title
);
754 list_of_panes (Fcdr (menu
));
761 discard_menu_items ();
767 /* Display them in a menu. */
768 record_unwind_protect (cleanup_popup_menu
, Qnil
);
771 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
772 keymaps
, title
, &error_name
);
774 unbind_to (specpdl_count
, Qnil
);
777 #endif /* HAVE_MENUS */
779 if (error_name
) error (error_name
);
785 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
786 doc
: /* Pop up a dialog box and return user's selection.
787 POSITION specifies which frame to use.
788 This is normally a mouse button event or a window or frame.
789 If POSITION is t, it means to use the frame the mouse is on.
790 The dialog box appears in the middle of the specified frame.
792 CONTENTS specifies the alternatives to display in the dialog box.
793 It is a list of the form (DIALOG ITEM1 ITEM2...).
794 Each ITEM is a cons cell (STRING . VALUE).
795 The return value is VALUE from the chosen item.
797 An ITEM may also be just a string--that makes a nonselectable item.
798 An ITEM may also be nil--that means to put all preceding items
799 on the left of the dialog box and all following items on the right.
800 \(By default, approximately half appear on each side.)
802 If HEADER is non-nil, the frame title for the box is "Information",
803 otherwise it is "Question".
805 If the user gets rid of the dialog box without making a valid choice,
806 for instance using the window manager, then this produces a quit and
807 `x-popup-dialog' does not return. */)
808 (position
, contents
, header
)
809 Lisp_Object position
, contents
, header
;
816 /* Decode the first argument: find the window or frame to use. */
817 if (EQ (position
, Qt
)
818 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
819 || EQ (XCAR (position
), Qtool_bar
)
820 || EQ (XCAR (position
), Qmac_apple_event
))))
822 #if 0 /* Using the frame the mouse is on may not be right. */
823 /* Use the mouse's current position. */
824 FRAME_PTR new_f
= SELECTED_FRAME ();
825 Lisp_Object bar_window
;
826 enum scroll_bar_part part
;
830 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
833 XSETFRAME (window
, new_f
);
835 window
= selected_window
;
837 window
= selected_window
;
839 else if (CONSP (position
))
842 tem
= Fcar (position
);
844 window
= Fcar (Fcdr (position
));
847 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
848 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
851 else if (WINDOWP (position
) || FRAMEP (position
))
856 /* Decode where to put the menu. */
860 else if (WINDOWP (window
))
862 CHECK_LIVE_WINDOW (window
);
863 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
866 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
867 but I don't want to make one now. */
868 CHECK_WINDOW (window
);
871 /* Display a menu with these alternatives
872 in the middle of frame F. */
874 Lisp_Object x
, y
, frame
, newpos
;
875 XSETFRAME (frame
, f
);
876 XSETINT (x
, x_pixel_width (f
) / 2);
877 XSETINT (y
, x_pixel_height (f
) / 2);
878 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
880 return Fx_popup_menu (newpos
,
881 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
883 #else /* HAVE_DIALOGS */
887 Lisp_Object selection
;
888 int specpdl_count
= SPECPDL_INDEX ();
890 /* Decode the dialog items from what was specified. */
891 title
= Fcar (contents
);
892 CHECK_STRING (title
);
894 list_of_panes (Fcons (contents
, Qnil
));
896 /* Display them in a dialog box. */
897 record_unwind_protect (cleanup_popup_menu
, Qnil
);
899 selection
= mac_dialog_show (f
, 0, title
, header
, &error_name
);
901 unbind_to (specpdl_count
, Qnil
);
903 if (error_name
) error (error_name
);
906 #endif /* HAVE_DIALOGS */
909 /* Find the menu selection and store it in the keyboard buffer.
910 F is the frame the menu is on.
911 MENU_BAR_ITEMS_USED is the length of VECTOR.
912 VECTOR is an array of menu events for the whole menu. */
915 find_and_call_menu_selection (f
, menu_bar_items_used
, vector
, client_data
)
917 int menu_bar_items_used
;
921 Lisp_Object prefix
, entry
;
922 Lisp_Object
*subprefix_stack
;
923 int submenu_depth
= 0;
927 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
931 while (i
< menu_bar_items_used
)
933 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
935 subprefix_stack
[submenu_depth
++] = prefix
;
939 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
941 prefix
= subprefix_stack
[--submenu_depth
];
944 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
946 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
947 i
+= MENU_ITEMS_PANE_LENGTH
;
951 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
952 /* The EMACS_INT cast avoids a warning. There's no problem
953 as long as pointers have enough bits to hold small integers. */
954 if ((int) (EMACS_INT
) client_data
== i
)
957 struct input_event buf
;
961 XSETFRAME (frame
, f
);
962 buf
.kind
= MENU_BAR_EVENT
;
963 buf
.frame_or_window
= frame
;
965 kbd_buffer_store_event (&buf
);
967 for (j
= 0; j
< submenu_depth
; j
++)
968 if (!NILP (subprefix_stack
[j
]))
970 buf
.kind
= MENU_BAR_EVENT
;
971 buf
.frame_or_window
= frame
;
972 buf
.arg
= subprefix_stack
[j
];
973 kbd_buffer_store_event (&buf
);
978 buf
.kind
= MENU_BAR_EVENT
;
979 buf
.frame_or_window
= frame
;
981 kbd_buffer_store_event (&buf
);
984 buf
.kind
= MENU_BAR_EVENT
;
985 buf
.frame_or_window
= frame
;
987 kbd_buffer_store_event (&buf
);
991 i
+= MENU_ITEMS_ITEM_LENGTH
;
996 /* Allocate a widget_value, blocking input. */
999 xmalloc_widget_value ()
1001 widget_value
*value
;
1004 value
= malloc_widget_value ();
1010 /* This recursively calls free_widget_value on the tree of widgets.
1011 It must free all data that was malloc'ed for these widget_values.
1012 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1013 must be left alone. */
1016 free_menubar_widget_value_tree (wv
)
1021 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1023 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1025 free_menubar_widget_value_tree (wv
->contents
);
1026 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1030 free_menubar_widget_value_tree (wv
->next
);
1031 wv
->next
= (widget_value
*) 0xDEADBEEF;
1034 free_widget_value (wv
);
1038 /* Set up data in menu_items for a menu bar item
1039 whose event type is ITEM_KEY (with string ITEM_NAME)
1040 and whose contents come from the list of keymaps MAPS. */
1043 parse_single_submenu (item_key
, item_name
, maps
)
1044 Lisp_Object item_key
, item_name
, maps
;
1048 Lisp_Object
*mapvec
;
1050 int top_level_items
= 0;
1052 length
= Flength (maps
);
1053 len
= XINT (length
);
1055 /* Convert the list MAPS into a vector MAPVEC. */
1056 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1057 for (i
= 0; i
< len
; i
++)
1059 mapvec
[i
] = Fcar (maps
);
1063 /* Loop over the given keymaps, making a pane for each map.
1064 But don't make a pane that is empty--ignore that map instead. */
1065 for (i
= 0; i
< len
; i
++)
1067 if (!KEYMAPP (mapvec
[i
]))
1069 /* Here we have a command at top level in the menu bar
1070 as opposed to a submenu. */
1071 top_level_items
= 1;
1072 push_menu_pane (Qnil
, Qnil
);
1073 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1074 Qnil
, Qnil
, Qnil
, Qnil
);
1079 prompt
= Fkeymap_prompt (mapvec
[i
]);
1080 single_keymap_panes (mapvec
[i
],
1081 !NILP (prompt
) ? prompt
: item_name
,
1086 return top_level_items
;
1089 /* Create a tree of widget_value objects
1090 representing the panes and items
1091 in menu_items starting at index START, up to index END. */
1093 static widget_value
*
1094 digest_single_submenu (start
, end
, top_level_items
)
1095 int start
, end
, top_level_items
;
1097 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1099 int submenu_depth
= 0;
1100 widget_value
**submenu_stack
;
1104 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1105 wv
= xmalloc_widget_value ();
1109 wv
->button_type
= BUTTON_TYPE_NONE
;
1115 /* Loop over all panes and items made by the preceding call
1116 to parse_single_submenu and construct a tree of widget_value objects.
1117 Ignore the panes and items used by previous calls to
1118 digest_single_submenu, even though those are also in menu_items. */
1122 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1124 submenu_stack
[submenu_depth
++] = save_wv
;
1129 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1132 save_wv
= submenu_stack
[--submenu_depth
];
1135 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1136 && submenu_depth
!= 0)
1137 i
+= MENU_ITEMS_PANE_LENGTH
;
1138 /* Ignore a nil in the item list.
1139 It's meaningful only for dialog boxes. */
1140 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1142 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1144 /* Create a new pane. */
1145 Lisp_Object pane_name
, prefix
;
1150 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1151 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1153 #ifndef HAVE_MULTILINGUAL_MENU
1154 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1156 pane_name
= ENCODE_MENU_STRING (pane_name
);
1157 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1160 pane_string
= (NILP (pane_name
)
1161 ? "" : (char *) SDATA (pane_name
));
1162 /* If there is just one top-level pane, put all its items directly
1163 under the top-level menu. */
1164 if (menu_items_n_panes
== 1)
1167 /* If the pane has a meaningful name,
1168 make the pane a top-level menu item
1169 with its items as a submenu beneath it. */
1170 if (strcmp (pane_string
, ""))
1172 wv
= xmalloc_widget_value ();
1176 first_wv
->contents
= wv
;
1177 wv
->lname
= pane_name
;
1178 /* Set value to 1 so update_submenu_strings can handle '@' */
1179 wv
->value
= (char *)1;
1181 wv
->button_type
= BUTTON_TYPE_NONE
;
1189 i
+= MENU_ITEMS_PANE_LENGTH
;
1193 /* Create a new item within current pane. */
1194 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1197 /* All items should be contained in panes. */
1198 if (panes_seen
== 0)
1201 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1202 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1203 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1204 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1205 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1206 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1207 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1209 #ifndef HAVE_MULTILINGUAL_MENU
1210 if (STRING_MULTIBYTE (item_name
))
1212 item_name
= ENCODE_MENU_STRING (item_name
);
1213 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1216 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1218 descrip
= ENCODE_MENU_STRING (descrip
);
1219 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1221 #endif /* not HAVE_MULTILINGUAL_MENU */
1223 wv
= xmalloc_widget_value ();
1227 save_wv
->contents
= wv
;
1229 wv
->lname
= item_name
;
1230 if (!NILP (descrip
))
1233 /* The EMACS_INT cast avoids a warning. There's no problem
1234 as long as pointers have enough bits to hold small integers. */
1235 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1236 wv
->enabled
= !NILP (enable
);
1239 wv
->button_type
= BUTTON_TYPE_NONE
;
1240 else if (EQ (type
, QCradio
))
1241 wv
->button_type
= BUTTON_TYPE_RADIO
;
1242 else if (EQ (type
, QCtoggle
))
1243 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1247 wv
->selected
= !NILP (selected
);
1248 if (! STRINGP (help
))
1255 i
+= MENU_ITEMS_ITEM_LENGTH
;
1259 /* If we have just one "menu item"
1260 that was originally a button, return it by itself. */
1261 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1263 wv
= first_wv
->contents
;
1264 free_widget_value (first_wv
);
1271 /* Walk through the widget_value tree starting at FIRST_WV and update
1272 the char * pointers from the corresponding lisp values.
1273 We do this after building the whole tree, since GC may happen while the
1274 tree is constructed, and small strings are relocated. So we must wait
1275 until no GC can happen before storing pointers into lisp values. */
1277 update_submenu_strings (first_wv
)
1278 widget_value
*first_wv
;
1282 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1284 if (STRINGP (wv
->lname
))
1286 wv
->name
= SDATA (wv
->lname
);
1288 /* Ignore the @ that means "separate pane".
1289 This is a kludge, but this isn't worth more time. */
1290 if (wv
->value
== (char *)1)
1292 if (wv
->name
[0] == '@')
1298 if (STRINGP (wv
->lkey
))
1299 wv
->key
= SDATA (wv
->lkey
);
1302 update_submenu_strings (wv
->contents
);
1307 /* Set the contents of the menubar widgets of frame F.
1308 The argument FIRST_TIME is currently ignored;
1309 it is set the first time this is called, from initialize_frame_menubar. */
1312 set_frame_menubar (f
, first_time
, deep_p
)
1317 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1319 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1321 int *submenu_start
, *submenu_end
;
1322 int *submenu_top_level_items
, *submenu_n_panes
;
1324 XSETFRAME (Vmenu_updating_frame
, f
);
1326 /* This seems to be unnecessary for Carbon. */
1328 if (! menubar_widget
)
1330 else if (pending_menu_activation
&& !deep_p
)
1336 /* Make a widget-value tree representing the entire menu trees. */
1338 struct buffer
*prev
= current_buffer
;
1340 int specpdl_count
= SPECPDL_INDEX ();
1341 int previous_menu_items_used
= f
->menu_bar_items_used
;
1342 Lisp_Object
*previous_items
1343 = (Lisp_Object
*) alloca (previous_menu_items_used
1344 * sizeof (Lisp_Object
));
1346 /* If we are making a new widget, its contents are empty,
1347 do always reinitialize them. */
1348 if (! menubar_widget
)
1349 previous_menu_items_used
= 0;
1351 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1352 specbind (Qinhibit_quit
, Qt
);
1353 /* Don't let the debugger step into this code
1354 because it is not reentrant. */
1355 specbind (Qdebug_on_next_call
, Qnil
);
1357 record_unwind_save_match_data ();
1358 if (NILP (Voverriding_local_map_menu_flag
))
1360 specbind (Qoverriding_terminal_local_map
, Qnil
);
1361 specbind (Qoverriding_local_map
, Qnil
);
1364 set_buffer_internal_1 (XBUFFER (buffer
));
1366 /* Run the Lucid hook. */
1367 safe_run_hooks (Qactivate_menubar_hook
);
1369 /* If it has changed current-menubar from previous value,
1370 really recompute the menubar from the value. */
1371 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1372 call0 (Qrecompute_lucid_menubar
);
1373 safe_run_hooks (Qmenu_bar_update_hook
);
1374 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1376 items
= FRAME_MENU_BAR_ITEMS (f
);
1378 /* Save the frame's previous menu bar contents data. */
1379 if (previous_menu_items_used
)
1380 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1381 previous_menu_items_used
* sizeof (Lisp_Object
));
1383 /* Fill in menu_items with the current menu bar contents.
1384 This can evaluate Lisp code. */
1387 menu_items
= f
->menu_bar_vector
;
1388 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1389 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1390 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1391 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1392 submenu_top_level_items
1393 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1395 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1397 Lisp_Object key
, string
, maps
;
1401 key
= XVECTOR (items
)->contents
[i
];
1402 string
= XVECTOR (items
)->contents
[i
+ 1];
1403 maps
= XVECTOR (items
)->contents
[i
+ 2];
1407 submenu_start
[i
] = menu_items_used
;
1409 menu_items_n_panes
= 0;
1410 submenu_top_level_items
[i
]
1411 = parse_single_submenu (key
, string
, maps
);
1412 submenu_n_panes
[i
] = menu_items_n_panes
;
1414 submenu_end
[i
] = menu_items_used
;
1417 finish_menu_items ();
1419 /* Convert menu_items into widget_value trees
1420 to display the menu. This cannot evaluate Lisp code. */
1422 wv
= xmalloc_widget_value ();
1423 wv
->name
= "menubar";
1426 wv
->button_type
= BUTTON_TYPE_NONE
;
1430 for (i
= 0; i
< last_i
; i
+= 4)
1432 menu_items_n_panes
= submenu_n_panes
[i
];
1433 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1434 submenu_top_level_items
[i
]);
1438 first_wv
->contents
= wv
;
1439 /* Don't set wv->name here; GC during the loop might relocate it. */
1441 wv
->button_type
= BUTTON_TYPE_NONE
;
1445 set_buffer_internal_1 (prev
);
1447 /* If there has been no change in the Lisp-level contents
1448 of the menu bar, skip redisplaying it. Just exit. */
1450 /* Compare the new menu items with the ones computed last time. */
1451 for (i
= 0; i
< previous_menu_items_used
; i
++)
1452 if (menu_items_used
== i
1453 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1455 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1457 /* The menu items have not changed. Don't bother updating
1458 the menus in any form, since it would be a no-op. */
1459 free_menubar_widget_value_tree (first_wv
);
1460 discard_menu_items ();
1461 unbind_to (specpdl_count
, Qnil
);
1465 /* The menu items are different, so store them in the frame. */
1466 f
->menu_bar_vector
= menu_items
;
1467 f
->menu_bar_items_used
= menu_items_used
;
1469 /* This calls restore_menu_items to restore menu_items, etc.,
1470 as they were outside. */
1471 unbind_to (specpdl_count
, Qnil
);
1473 /* Now GC cannot happen during the lifetime of the widget_value,
1474 so it's safe to store data from a Lisp_String. */
1475 wv
= first_wv
->contents
;
1476 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1479 string
= XVECTOR (items
)->contents
[i
+ 1];
1482 wv
->name
= (char *) SDATA (string
);
1483 update_submenu_strings (wv
->contents
);
1490 /* Make a widget-value tree containing
1491 just the top level menu bar strings. */
1493 wv
= xmalloc_widget_value ();
1494 wv
->name
= "menubar";
1497 wv
->button_type
= BUTTON_TYPE_NONE
;
1501 items
= FRAME_MENU_BAR_ITEMS (f
);
1502 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1506 string
= XVECTOR (items
)->contents
[i
+ 1];
1510 wv
= xmalloc_widget_value ();
1511 wv
->name
= (char *) SDATA (string
);
1514 wv
->button_type
= BUTTON_TYPE_NONE
;
1516 /* This prevents lwlib from assuming this
1517 menu item is really supposed to be empty. */
1518 /* The EMACS_INT cast avoids a warning.
1519 This value just has to be different from small integers. */
1520 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1525 first_wv
->contents
= wv
;
1529 /* Forget what we thought we knew about what is in the
1530 detailed contents of the menu bar menus.
1531 Changing the top level always destroys the contents. */
1532 f
->menu_bar_items_used
= 0;
1535 /* Create or update the menu bar widget. */
1539 /* Non-null value to indicate menubar has already been "created". */
1540 f
->output_data
.mac
->menubar_widget
= 1;
1542 mac_fill_menubar (first_wv
->contents
, deep_p
);
1544 free_menubar_widget_value_tree (first_wv
);
1549 /* Get rid of the menu bar of frame F, and free its storage.
1550 This is used when deleting a frame, and when turning off the menu bar. */
1553 free_frame_menubar (f
)
1556 f
->output_data
.mac
->menubar_widget
= 0;
1560 /* The item selected in the popup menu. */
1561 int menu_item_selection
;
1563 /* Mac_menu_show actually displays a menu using the panes and items in
1564 menu_items and returns the value selected from it; we assume input
1565 is blocked by the caller. */
1567 /* F is the frame the menu is for.
1568 X and Y are the frame-relative specified position,
1569 relative to the inside upper left corner of the frame F.
1570 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1571 KEYMAPS is 1 if this menu was specified with keymaps;
1572 in that case, we return a list containing the chosen item's value
1573 and perhaps also the pane's prefix.
1574 TITLE is the specified menu title.
1575 ERROR is a place to store an error message string in case of failure.
1576 (We return nil on failure, but the value doesn't actually matter.) */
1579 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1589 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1590 widget_value
**submenu_stack
1591 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1592 Lisp_Object
*subprefix_stack
1593 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1594 int submenu_depth
= 0;
1600 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1602 *error
= "Empty menu";
1606 /* Create a tree of widget_value objects
1607 representing the panes and their items. */
1608 wv
= xmalloc_widget_value ();
1612 wv
->button_type
= BUTTON_TYPE_NONE
;
1617 /* Loop over all panes and items, filling in the tree. */
1619 while (i
< menu_items_used
)
1621 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1623 submenu_stack
[submenu_depth
++] = save_wv
;
1629 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1632 save_wv
= submenu_stack
[--submenu_depth
];
1636 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1637 && submenu_depth
!= 0)
1638 i
+= MENU_ITEMS_PANE_LENGTH
;
1639 /* Ignore a nil in the item list.
1640 It's meaningful only for dialog boxes. */
1641 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1643 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1645 /* Create a new pane. */
1646 Lisp_Object pane_name
, prefix
;
1649 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1650 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1652 #ifndef HAVE_MULTILINGUAL_MENU
1653 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1655 pane_name
= ENCODE_MENU_STRING (pane_name
);
1656 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1659 pane_string
= (NILP (pane_name
)
1660 ? "" : (char *) SDATA (pane_name
));
1661 /* If there is just one top-level pane, put all its items directly
1662 under the top-level menu. */
1663 if (menu_items_n_panes
== 1)
1666 /* If the pane has a meaningful name,
1667 make the pane a top-level menu item
1668 with its items as a submenu beneath it. */
1669 if (!keymaps
&& strcmp (pane_string
, ""))
1671 wv
= xmalloc_widget_value ();
1675 first_wv
->contents
= wv
;
1676 wv
->name
= pane_string
;
1677 if (keymaps
&& !NILP (prefix
))
1681 wv
->button_type
= BUTTON_TYPE_NONE
;
1686 else if (first_pane
)
1692 i
+= MENU_ITEMS_PANE_LENGTH
;
1696 /* Create a new item within current pane. */
1697 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1698 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1699 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1700 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1701 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1702 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1703 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1704 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1706 #ifndef HAVE_MULTILINGUAL_MENU
1707 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1709 item_name
= ENCODE_MENU_STRING (item_name
);
1710 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1713 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1715 descrip
= ENCODE_MENU_STRING (descrip
);
1716 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1718 #endif /* not HAVE_MULTILINGUAL_MENU */
1720 wv
= xmalloc_widget_value ();
1724 save_wv
->contents
= wv
;
1725 wv
->name
= (char *) SDATA (item_name
);
1726 if (!NILP (descrip
))
1727 wv
->key
= (char *) SDATA (descrip
);
1729 /* Use the contents index as call_data, since we are
1730 restricted to 16-bits. */
1731 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1732 wv
->enabled
= !NILP (enable
);
1735 wv
->button_type
= BUTTON_TYPE_NONE
;
1736 else if (EQ (type
, QCtoggle
))
1737 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1738 else if (EQ (type
, QCradio
))
1739 wv
->button_type
= BUTTON_TYPE_RADIO
;
1743 wv
->selected
= !NILP (selected
);
1745 if (! STRINGP (help
))
1752 i
+= MENU_ITEMS_ITEM_LENGTH
;
1756 /* Deal with the title, if it is non-nil. */
1759 widget_value
*wv_title
= xmalloc_widget_value ();
1760 widget_value
*wv_sep
= xmalloc_widget_value ();
1762 /* Maybe replace this separator with a bitmap or owner-draw item
1763 so that it looks better. Having two separators looks odd. */
1764 wv_sep
->name
= "--";
1765 wv_sep
->next
= first_wv
->contents
;
1766 wv_sep
->help
= Qnil
;
1768 #ifndef HAVE_MULTILINGUAL_MENU
1769 if (STRING_MULTIBYTE (title
))
1770 title
= ENCODE_MENU_STRING (title
);
1773 wv_title
->name
= (char *) SDATA (title
);
1774 wv_title
->enabled
= FALSE
;
1775 wv_title
->title
= TRUE
;
1776 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1777 wv_title
->help
= Qnil
;
1778 wv_title
->next
= wv_sep
;
1779 first_wv
->contents
= wv_title
;
1782 /* No selection has been chosen yet. */
1783 menu_item_selection
= 0;
1785 /* Actually create and show the menu until popped down. */
1786 create_and_show_popup_menu (f
, first_wv
, x
, y
, for_click
);
1788 /* Free the widget_value objects we used to specify the contents. */
1789 free_menubar_widget_value_tree (first_wv
);
1791 /* Find the selected item, and its pane, to return
1792 the proper value. */
1793 if (menu_item_selection
!= 0)
1795 Lisp_Object prefix
, entry
;
1797 prefix
= entry
= Qnil
;
1799 while (i
< menu_items_used
)
1801 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1803 subprefix_stack
[submenu_depth
++] = prefix
;
1807 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1809 prefix
= subprefix_stack
[--submenu_depth
];
1812 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1815 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1816 i
+= MENU_ITEMS_PANE_LENGTH
;
1818 /* Ignore a nil in the item list.
1819 It's meaningful only for dialog boxes. */
1820 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1825 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1826 if (menu_item_selection
== i
)
1832 entry
= Fcons (entry
, Qnil
);
1834 entry
= Fcons (prefix
, entry
);
1835 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1836 if (!NILP (subprefix_stack
[j
]))
1837 entry
= Fcons (subprefix_stack
[j
], entry
);
1841 i
+= MENU_ITEMS_ITEM_LENGTH
;
1845 else if (!for_click
)
1846 /* Make "Cancel" equivalent to C-g. */
1847 Fsignal (Qquit
, Qnil
);
1854 /* Construct native Mac OS dialog based on widget_value tree. */
1856 static char * button_names
[] = {
1857 "button1", "button2", "button3", "button4", "button5",
1858 "button6", "button7", "button8", "button9", "button10" };
1861 mac_dialog_show (f
, keymaps
, title
, header
, error_name
)
1864 Lisp_Object title
, header
;
1867 int i
, nb_buttons
=0;
1868 char dialog_name
[6];
1870 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1872 /* Number of elements seen so far, before boundary. */
1874 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1875 int boundary_seen
= 0;
1879 if (menu_items_n_panes
> 1)
1881 *error_name
= "Multiple panes in dialog box";
1885 /* Create a tree of widget_value objects
1886 representing the text label and buttons. */
1888 Lisp_Object pane_name
, prefix
;
1890 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1891 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1892 pane_string
= (NILP (pane_name
)
1893 ? "" : (char *) SDATA (pane_name
));
1894 prev_wv
= xmalloc_widget_value ();
1895 prev_wv
->value
= pane_string
;
1896 if (keymaps
&& !NILP (prefix
))
1898 prev_wv
->enabled
= 1;
1899 prev_wv
->name
= "message";
1900 prev_wv
->help
= Qnil
;
1903 /* Loop over all panes and items, filling in the tree. */
1904 i
= MENU_ITEMS_PANE_LENGTH
;
1905 while (i
< menu_items_used
)
1908 /* Create a new item within current pane. */
1909 Lisp_Object item_name
, enable
, descrip
;
1910 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1911 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1913 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1915 if (NILP (item_name
))
1917 free_menubar_widget_value_tree (first_wv
);
1918 *error_name
= "Submenu in dialog items";
1921 if (EQ (item_name
, Qquote
))
1923 /* This is the boundary between left-side elts
1924 and right-side elts. Stop incrementing right_count. */
1929 if (nb_buttons
>= 9)
1931 free_menubar_widget_value_tree (first_wv
);
1932 *error_name
= "Too many dialog items";
1936 wv
= xmalloc_widget_value ();
1938 wv
->name
= (char *) button_names
[nb_buttons
];
1939 if (!NILP (descrip
))
1940 wv
->key
= (char *) SDATA (descrip
);
1941 wv
->value
= (char *) SDATA (item_name
);
1942 wv
->call_data
= (void *) i
;
1943 /* menu item is identified by its index in menu_items table */
1944 wv
->enabled
= !NILP (enable
);
1948 if (! boundary_seen
)
1952 i
+= MENU_ITEMS_ITEM_LENGTH
;
1955 /* If the boundary was not specified,
1956 by default put half on the left and half on the right. */
1957 if (! boundary_seen
)
1958 left_count
= nb_buttons
- nb_buttons
/ 2;
1960 wv
= xmalloc_widget_value ();
1961 wv
->name
= dialog_name
;
1964 /* Frame title: 'Q' = Question, 'I' = Information.
1965 Can also have 'E' = Error if, one day, we want
1966 a popup for errors. */
1968 dialog_name
[0] = 'Q';
1970 dialog_name
[0] = 'I';
1972 /* Dialog boxes use a really stupid name encoding
1973 which specifies how many buttons to use
1974 and how many buttons are on the right. */
1975 dialog_name
[1] = '0' + nb_buttons
;
1976 dialog_name
[2] = 'B';
1977 dialog_name
[3] = 'R';
1978 /* Number of buttons to put on the right. */
1979 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1981 wv
->contents
= first_wv
;
1985 /* No selection has been chosen yet. */
1986 menu_item_selection
= 0;
1988 /* Force a redisplay before showing the dialog. If a frame is created
1989 just before showing the dialog, its contents may not have been fully
1993 /* Actually create the dialog. */
1994 #if TARGET_API_MAC_CARBON
1995 create_and_show_dialog (f
, first_wv
);
1997 menu_item_selection
= mac_dialog (first_wv
);
2000 /* Free the widget_value objects we used to specify the contents. */
2001 free_menubar_widget_value_tree (first_wv
);
2003 /* Find the selected item, and its pane, to return
2004 the proper value. */
2005 if (menu_item_selection
!= 0)
2011 while (i
< menu_items_used
)
2015 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2018 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2019 i
+= MENU_ITEMS_PANE_LENGTH
;
2021 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2023 /* This is the boundary between left-side elts and
2030 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2031 if (menu_item_selection
== i
)
2035 entry
= Fcons (entry
, Qnil
);
2037 entry
= Fcons (prefix
, entry
);
2041 i
+= MENU_ITEMS_ITEM_LENGTH
;
2046 /* Make "Cancel" equivalent to C-g. */
2047 Fsignal (Qquit
, Qnil
);
2051 #endif /* HAVE_DIALOGS */
2054 /* Is this item a separator? */
2056 name_is_separator (name
)
2059 const char *start
= name
;
2061 /* Check if name string consists of only dashes ('-'). */
2062 while (*name
== '-') name
++;
2063 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2064 or "--deep-shadow". We don't implement them yet, se we just treat
2065 them like normal separators. */
2066 return (*name
== '\0' || start
+ 2 == name
);
2068 #endif /* HAVE_MENUS */
2070 /* Detect if a menu is currently active. */
2075 return popup_activated_flag
;
2078 /* The following is used by delayed window autoselection. */
2080 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2081 doc
: /* Return t if a menu or popup dialog is active. */)
2084 #if TARGET_API_MAC_CARBON
2085 return (popup_activated ()) ? Qt
: Qnil
;
2087 /* Always return Qnil since menu selection functions do not return
2088 until a selection has been made or cancelled. */
2096 staticpro (&menu_items
);
2099 Qdebug_on_next_call
= intern ("debug-on-next-call");
2100 staticpro (&Qdebug_on_next_call
);
2102 defsubr (&Sx_popup_menu
);
2103 defsubr (&Smenu_or_popup_active_p
);
2105 defsubr (&Sx_popup_dialog
);
2109 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2110 (do not change this comment) */