1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
3 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 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* Contributed by Andrew Choi (akochoi@mac.com). */
28 #include "termhooks.h"
32 #include "blockinput.h"
37 /* This may include sys/types.h, and that somehow loses
38 if this is not done before the other system files. */
41 /* Load sys/types.h if not already loaded.
42 In some systems loading it twice is suicidal. */
44 #include <sys/types.h>
47 #include "dispextern.h"
49 #if TARGET_API_MAC_CARBON
50 #define HAVE_DIALOGS 1
53 #undef HAVE_MULTILINGUAL_MENU
55 /******************************************************************/
57 /* Assumed by other routines to zero area returned. */
58 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
59 0, (sizeof (widget_value)))
60 #define free_widget_value(wv) xfree (wv)
62 /******************************************************************/
69 Lisp_Object Qdebug_on_next_call
;
71 extern Lisp_Object Vmenu_updating_frame
;
73 extern Lisp_Object Qmenu_bar
, Qmac_apple_event
;
75 extern Lisp_Object QCtoggle
, QCradio
;
77 extern Lisp_Object Voverriding_local_map
;
78 extern Lisp_Object Voverriding_local_map_menu_flag
;
80 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
82 extern Lisp_Object Qmenu_bar_update_hook
;
84 void set_frame_menubar
P_ ((FRAME_PTR
, int, int));
86 #if TARGET_API_MAC_CARBON
87 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
89 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
92 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
93 Lisp_Object
, Lisp_Object
, Lisp_Object
,
94 Lisp_Object
, Lisp_Object
));
96 static Lisp_Object mac_dialog_show
P_ ((FRAME_PTR
, int, Lisp_Object
,
97 Lisp_Object
, char **));
99 static Lisp_Object mac_menu_show
P_ ((struct frame
*, int, int, int, int,
100 Lisp_Object
, char **));
101 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
102 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
104 static void list_of_panes
P_ ((Lisp_Object
));
105 static void list_of_items
P_ ((Lisp_Object
));
108 /* This holds a Lisp vector that holds the results of decoding
109 the keymaps or alist-of-alists that specify a menu.
111 It describes the panes and items within the panes.
113 Each pane is described by 3 elements in the vector:
114 t, the pane name, the pane's prefix key.
115 Then follow the pane's items, with 5 elements per item:
116 the item string, the enable flag, the item's value,
117 the definition, and the equivalent keyboard key's description string.
119 In some cases, multiple levels of menus may be described.
120 A single vector slot containing nil indicates the start of a submenu.
121 A single vector slot containing lambda indicates the end of a submenu.
122 The submenu follows a menu item which is the way to reach the submenu.
124 A single vector slot containing quote indicates that the
125 following items should appear on the right of a dialog box.
127 Using a Lisp vector to hold this information while we decode it
128 takes care of protecting all the data from GC. */
130 #define MENU_ITEMS_PANE_NAME 1
131 #define MENU_ITEMS_PANE_PREFIX 2
132 #define MENU_ITEMS_PANE_LENGTH 3
136 MENU_ITEMS_ITEM_NAME
= 0,
137 MENU_ITEMS_ITEM_ENABLE
,
138 MENU_ITEMS_ITEM_VALUE
,
139 MENU_ITEMS_ITEM_EQUIV_KEY
,
140 MENU_ITEMS_ITEM_DEFINITION
,
141 MENU_ITEMS_ITEM_TYPE
,
142 MENU_ITEMS_ITEM_SELECTED
,
143 MENU_ITEMS_ITEM_HELP
,
144 MENU_ITEMS_ITEM_LENGTH
147 static Lisp_Object menu_items
;
149 /* Number of slots currently allocated in menu_items. */
150 static int menu_items_allocated
;
152 /* This is the index in menu_items of the first empty slot. */
153 static int menu_items_used
;
155 /* The number of panes currently recorded in menu_items,
156 excluding those within submenus. */
157 static int menu_items_n_panes
;
159 /* Current depth within submenus. */
160 static int menu_items_submenu_depth
;
162 /* Nonzero means a menu is currently active. */
163 int popup_activated_flag
;
165 /* This is set nonzero after the user activates the menu bar, and set
166 to zero again after the menu bars are redisplayed by prepare_menu_bar.
167 While it is nonzero, all calls to set_frame_menubar go deep.
169 I don't understand why this is needed, but it does seem to be
170 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
172 int pending_menu_activation
;
174 /* Initialize the menu_items structure if we haven't already done so.
175 Also mark it as currently empty. */
180 if (NILP (menu_items
))
182 menu_items_allocated
= 60;
183 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
187 menu_items_n_panes
= 0;
188 menu_items_submenu_depth
= 0;
191 /* Call at the end of generating the data in menu_items. */
198 /* Call when finished using the data for the current menu
202 discard_menu_items ()
204 /* Free the structure if it is especially large.
205 Otherwise, hold on to it, to save time. */
206 if (menu_items_allocated
> 200)
209 menu_items_allocated
= 0;
213 /* This undoes save_menu_items, and it is called by the specpdl unwind
217 restore_menu_items (saved
)
220 menu_items
= XCAR (saved
);
221 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
222 saved
= XCDR (saved
);
223 menu_items_used
= XINT (XCAR (saved
));
224 saved
= XCDR (saved
);
225 menu_items_n_panes
= XINT (XCAR (saved
));
226 saved
= XCDR (saved
);
227 menu_items_submenu_depth
= XINT (XCAR (saved
));
231 /* Push the whole state of menu_items processing onto the specpdl.
232 It will be restored when the specpdl is unwound. */
237 Lisp_Object saved
= list4 (menu_items
,
238 make_number (menu_items_used
),
239 make_number (menu_items_n_panes
),
240 make_number (menu_items_submenu_depth
));
241 record_unwind_protect (restore_menu_items
, saved
);
245 /* Make the menu_items vector twice as large. */
250 menu_items_allocated
*= 2;
251 menu_items
= larger_vector (menu_items
, menu_items_allocated
, Qnil
);
254 /* Begin a submenu. */
257 push_submenu_start ()
259 if (menu_items_used
+ 1 > menu_items_allocated
)
262 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
263 menu_items_submenu_depth
++;
271 if (menu_items_used
+ 1 > menu_items_allocated
)
274 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
275 menu_items_submenu_depth
--;
278 /* Indicate boundary between left and right. */
281 push_left_right_boundary ()
283 if (menu_items_used
+ 1 > menu_items_allocated
)
286 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
289 /* Start a new menu pane in menu_items.
290 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
293 push_menu_pane (name
, prefix_vec
)
294 Lisp_Object name
, prefix_vec
;
296 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
299 if (menu_items_submenu_depth
== 0)
300 menu_items_n_panes
++;
301 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
302 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
303 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
306 /* Push one menu item into the current pane. NAME is the string to
307 display. ENABLE if non-nil means this item can be selected. KEY
308 is the key generated by choosing this item, or nil if this item
309 doesn't really have a definition. DEF is the definition of this
310 item. EQUIV is the textual description of the keyboard equivalent
311 for this item (or nil if none). TYPE is the type of this menu
312 item, one of nil, `toggle' or `radio'. */
315 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
316 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
318 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
321 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
322 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
323 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
324 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
325 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
326 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
327 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
328 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
331 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
332 and generate menu panes for them in menu_items.
333 If NOTREAL is nonzero,
334 don't bother really computing whether an item is enabled. */
337 keymap_panes (keymaps
, nmaps
, notreal
)
338 Lisp_Object
*keymaps
;
346 /* Loop over the given keymaps, making a pane for each map.
347 But don't make a pane that is empty--ignore that map instead.
348 P is the number of panes we have made so far. */
349 for (mapno
= 0; mapno
< nmaps
; mapno
++)
350 single_keymap_panes (keymaps
[mapno
],
351 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
353 finish_menu_items ();
356 /* Args passed between single_keymap_panes and single_menu_item. */
359 Lisp_Object pending_maps
;
360 int maxdepth
, notreal
;
363 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
366 /* This is a recursive subroutine of keymap_panes.
367 It handles one keymap, KEYMAP.
368 The other arguments are passed along
369 or point to local variables of the previous function.
370 If NOTREAL is nonzero, only check for equivalent key bindings, don't
371 evaluate expressions in menu items and don't make any menu.
373 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
376 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
378 Lisp_Object pane_name
;
386 skp
.pending_maps
= Qnil
;
387 skp
.maxdepth
= maxdepth
;
388 skp
.notreal
= notreal
;
393 push_menu_pane (pane_name
, prefix
);
395 GCPRO1 (skp
.pending_maps
);
396 map_keymap (keymap
, single_menu_item
, Qnil
, &skp
, 1);
399 /* Process now any submenus which want to be panes at this level. */
400 while (CONSP (skp
.pending_maps
))
402 Lisp_Object elt
, eltcdr
, string
;
403 elt
= XCAR (skp
.pending_maps
);
405 string
= XCAR (eltcdr
);
406 /* We no longer discard the @ from the beginning of the string here.
407 Instead, we do this in mac_menu_show. */
408 single_keymap_panes (Fcar (elt
), string
,
409 XCDR (eltcdr
), notreal
, maxdepth
- 1);
410 skp
.pending_maps
= XCDR (skp
.pending_maps
);
414 /* This is a subroutine of single_keymap_panes that handles one
416 KEY is a key in a keymap and ITEM is its binding.
417 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
419 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
420 evaluate expressions in menu items and don't make any menu.
421 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
424 single_menu_item (key
, item
, dummy
, skp_v
)
425 Lisp_Object key
, item
, dummy
;
428 Lisp_Object map
, item_string
, enabled
;
429 struct gcpro gcpro1
, gcpro2
;
431 struct skp
*skp
= skp_v
;
433 /* Parse the menu item and leave the result in item_properties. */
435 res
= parse_menu_item (item
, skp
->notreal
, 0);
438 return; /* Not a menu item. */
440 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
444 /* We don't want to make a menu, just traverse the keymaps to
445 precompute equivalent key bindings. */
447 single_keymap_panes (map
, Qnil
, key
, 1, skp
->maxdepth
- 1);
451 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
452 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
454 if (!NILP (map
) && SREF (item_string
, 0) == '@')
457 /* An enabled separate pane. Remember this to handle it later. */
458 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
463 push_menu_item (item_string
, enabled
, key
,
464 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
465 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
466 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
467 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
468 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
470 /* Display a submenu using the toolkit. */
471 if (! (NILP (map
) || NILP (enabled
)))
473 push_submenu_start ();
474 single_keymap_panes (map
, Qnil
, key
, 0, skp
->maxdepth
- 1);
479 /* Push all the panes and items of a menu described by the
480 alist-of-alists MENU.
481 This handles old-fashioned calls to x-popup-menu. */
491 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
493 Lisp_Object elt
, pane_name
, pane_data
;
495 pane_name
= Fcar (elt
);
496 CHECK_STRING (pane_name
);
497 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
498 pane_data
= Fcdr (elt
);
499 CHECK_CONS (pane_data
);
500 list_of_items (pane_data
);
503 finish_menu_items ();
506 /* Push the items in a single pane defined by the alist PANE. */
512 Lisp_Object tail
, item
, item1
;
514 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
518 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
519 Qnil
, Qnil
, Qnil
, Qnil
);
520 else if (CONSP (item
))
523 CHECK_STRING (item1
);
524 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
525 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
528 push_left_right_boundary ();
534 cleanup_popup_menu (arg
)
537 discard_menu_items ();
541 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
542 doc
: /* Pop up a deck-of-cards menu and return user's selection.
543 POSITION is a position specification. This is either a mouse button event
544 or a list ((XOFFSET YOFFSET) WINDOW)
545 where XOFFSET and YOFFSET are positions in pixels from the top left
546 corner of WINDOW. (WINDOW may be a window or a frame object.)
547 This controls the position of the top left of the menu as a whole.
548 If POSITION is t, it means to use the current mouse position.
550 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
551 The menu items come from key bindings that have a menu string as well as
552 a definition; actually, the "definition" in such a key binding looks like
553 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
554 the keymap as a top-level element.
556 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
557 Otherwise, REAL-DEFINITION should be a valid key binding definition.
559 You can also use a list of keymaps as MENU.
560 Then each keymap makes a separate pane.
562 When MENU is a keymap or a list of keymaps, the return value is the
563 list of events corresponding to the user's choice. Note that
564 `x-popup-menu' does not actually execute the command bound to that
567 Alternatively, you can specify a menu of multiple panes
568 with a list of the form (TITLE PANE1 PANE2...),
569 where each pane is a list of form (TITLE ITEM1 ITEM2...).
570 Each ITEM is normally a cons cell (STRING . VALUE);
571 but a string can appear as an item--that makes a nonselectable line
573 With this form of menu, the return value is VALUE from the chosen item.
575 If POSITION is nil, don't display the menu at all, just precalculate the
576 cached information about equivalent key sequences.
578 If the user gets rid of the menu without making a valid choice, for
579 instance by clicking the mouse away from a valid choice or by typing
580 keyboard input, then this normally results in a quit and
581 `x-popup-menu' does not return. But if POSITION is a mouse button
582 event (indicating that the user invoked the menu with the mouse) then
583 no quit occurs and `x-popup-menu' returns nil. */)
585 Lisp_Object position
, menu
;
587 Lisp_Object keymap
, tem
;
588 int xpos
= 0, ypos
= 0;
590 char *error_name
= NULL
;
591 Lisp_Object selection
;
593 Lisp_Object x
, y
, window
;
596 int specpdl_count
= SPECPDL_INDEX ();
600 if (! NILP (position
))
604 /* Decode the first argument: find the window and the coordinates. */
605 if (EQ (position
, Qt
)
606 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
607 || EQ (XCAR (position
), Qtool_bar
)
608 || EQ (XCAR (position
), Qmac_apple_event
))))
610 /* Use the mouse's current position. */
611 FRAME_PTR new_f
= SELECTED_FRAME ();
612 Lisp_Object bar_window
;
613 enum scroll_bar_part part
;
616 if (FRAME_TERMINAL (new_f
)->mouse_position_hook
)
617 (*FRAME_TERMINAL (new_f
)->mouse_position_hook
) (&new_f
, 1, &bar_window
,
618 &part
, &x
, &y
, &time
);
620 XSETFRAME (window
, new_f
);
623 window
= selected_window
;
630 tem
= Fcar (position
);
633 window
= Fcar (Fcdr (position
));
635 y
= Fcar (XCDR (tem
));
640 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
641 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
642 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
651 /* Decode where to put the menu. */
659 else if (WINDOWP (window
))
661 CHECK_LIVE_WINDOW (window
);
662 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
664 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
665 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
668 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
669 but I don't want to make one now. */
670 CHECK_WINDOW (window
);
675 XSETFRAME (Vmenu_updating_frame
, f
);
678 Vmenu_updating_frame
= Qnil
;
679 #endif /* HAVE_MENUS */
684 /* Decode the menu items from what was specified. */
686 keymap
= get_keymap (menu
, 0, 0);
689 /* We were given a keymap. Extract menu info from the keymap. */
692 /* Extract the detailed info to make one pane. */
693 keymap_panes (&menu
, 1, NILP (position
));
695 /* Search for a string appearing directly as an element of the keymap.
696 That string is the title of the menu. */
697 prompt
= Fkeymap_prompt (keymap
);
698 if (NILP (title
) && !NILP (prompt
))
701 /* Make that be the pane title of the first pane. */
702 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
703 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
707 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
709 /* We were given a list of keymaps. */
710 int nmaps
= XFASTINT (Flength (menu
));
712 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
717 /* The first keymap that has a prompt string
718 supplies the menu title. */
719 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
723 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
725 prompt
= Fkeymap_prompt (keymap
);
726 if (NILP (title
) && !NILP (prompt
))
730 /* Extract the detailed info to make one pane. */
731 keymap_panes (maps
, nmaps
, NILP (position
));
733 /* Make the title be the pane title of the first pane. */
734 if (!NILP (title
) && menu_items_n_panes
>= 0)
735 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
741 /* We were given an old-fashioned menu. */
743 CHECK_STRING (title
);
745 list_of_panes (Fcdr (menu
));
752 discard_menu_items ();
758 /* Display them in a menu. */
759 record_unwind_protect (cleanup_popup_menu
, Qnil
);
762 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
763 keymaps
, title
, &error_name
);
765 unbind_to (specpdl_count
, Qnil
);
768 #endif /* HAVE_MENUS */
770 if (error_name
) error (error_name
);
776 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
777 doc
: /* Pop up a dialog box and return user's selection.
778 POSITION specifies which frame to use.
779 This is normally a mouse button event or a window or frame.
780 If POSITION is t, it means to use the frame the mouse is on.
781 The dialog box appears in the middle of the specified frame.
783 CONTENTS specifies the alternatives to display in the dialog box.
784 It is a list of the form (DIALOG ITEM1 ITEM2...).
785 Each ITEM is a cons cell (STRING . VALUE).
786 The return value is VALUE from the chosen item.
788 An ITEM may also be just a string--that makes a nonselectable item.
789 An ITEM may also be nil--that means to put all preceding items
790 on the left of the dialog box and all following items on the right.
791 \(By default, approximately half appear on each side.)
793 If HEADER is non-nil, the frame title for the box is "Information",
794 otherwise it is "Question".
796 If the user gets rid of the dialog box without making a valid choice,
797 for instance using the window manager, then this produces a quit and
798 `x-popup-dialog' does not return. */)
799 (position
, contents
, header
)
800 Lisp_Object position
, contents
, header
;
807 /* Decode the first argument: find the window or frame to use. */
808 if (EQ (position
, Qt
)
809 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
810 || EQ (XCAR (position
), Qtool_bar
)
811 || EQ (XCAR (position
), Qmac_apple_event
))))
813 #if 0 /* Using the frame the mouse is on may not be right. */
814 /* Use the mouse's current position. */
815 FRAME_PTR new_f
= SELECTED_FRAME ();
816 Lisp_Object bar_window
;
817 enum scroll_bar_part part
;
821 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
824 XSETFRAME (window
, new_f
);
826 window
= selected_window
;
828 window
= selected_window
;
830 else if (CONSP (position
))
833 tem
= Fcar (position
);
835 window
= Fcar (Fcdr (position
));
838 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
839 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
842 else if (WINDOWP (position
) || FRAMEP (position
))
847 /* Decode where to put the menu. */
851 else if (WINDOWP (window
))
853 CHECK_LIVE_WINDOW (window
);
854 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
857 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
858 but I don't want to make one now. */
859 CHECK_WINDOW (window
);
862 /* Display a menu with these alternatives
863 in the middle of frame F. */
865 Lisp_Object x
, y
, frame
, newpos
;
866 XSETFRAME (frame
, f
);
867 XSETINT (x
, x_pixel_width (f
) / 2);
868 XSETINT (y
, x_pixel_height (f
) / 2);
869 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
871 return Fx_popup_menu (newpos
,
872 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
874 #else /* HAVE_DIALOGS */
878 Lisp_Object selection
;
879 int specpdl_count
= SPECPDL_INDEX ();
881 /* Decode the dialog items from what was specified. */
882 title
= Fcar (contents
);
883 CHECK_STRING (title
);
885 list_of_panes (Fcons (contents
, Qnil
));
887 /* Display them in a dialog box. */
888 record_unwind_protect (cleanup_popup_menu
, Qnil
);
890 selection
= mac_dialog_show (f
, 0, title
, header
, &error_name
);
892 unbind_to (specpdl_count
, Qnil
);
894 if (error_name
) error (error_name
);
897 #endif /* HAVE_DIALOGS */
900 /* Find the menu selection and store it in the keyboard buffer.
901 F is the frame the menu is on.
902 MENU_BAR_ITEMS_USED is the length of VECTOR.
903 VECTOR is an array of menu events for the whole menu. */
906 find_and_call_menu_selection (f
, menu_bar_items_used
, vector
, client_data
)
908 int menu_bar_items_used
;
912 Lisp_Object prefix
, entry
;
913 Lisp_Object
*subprefix_stack
;
914 int submenu_depth
= 0;
918 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
922 while (i
< menu_bar_items_used
)
924 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
926 subprefix_stack
[submenu_depth
++] = prefix
;
930 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
932 prefix
= subprefix_stack
[--submenu_depth
];
935 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
937 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
938 i
+= MENU_ITEMS_PANE_LENGTH
;
942 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
943 /* The EMACS_INT cast avoids a warning. There's no problem
944 as long as pointers have enough bits to hold small integers. */
945 if ((int) (EMACS_INT
) client_data
== i
)
948 struct input_event buf
;
952 XSETFRAME (frame
, f
);
953 buf
.kind
= MENU_BAR_EVENT
;
954 buf
.frame_or_window
= frame
;
956 kbd_buffer_store_event (&buf
);
958 for (j
= 0; j
< submenu_depth
; j
++)
959 if (!NILP (subprefix_stack
[j
]))
961 buf
.kind
= MENU_BAR_EVENT
;
962 buf
.frame_or_window
= frame
;
963 buf
.arg
= subprefix_stack
[j
];
964 kbd_buffer_store_event (&buf
);
969 buf
.kind
= MENU_BAR_EVENT
;
970 buf
.frame_or_window
= frame
;
972 kbd_buffer_store_event (&buf
);
975 buf
.kind
= MENU_BAR_EVENT
;
976 buf
.frame_or_window
= frame
;
978 kbd_buffer_store_event (&buf
);
982 i
+= MENU_ITEMS_ITEM_LENGTH
;
987 /* Allocate a widget_value, blocking input. */
990 xmalloc_widget_value ()
995 value
= malloc_widget_value ();
1001 /* This recursively calls free_widget_value on the tree of widgets.
1002 It must free all data that was malloc'ed for these widget_values.
1003 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1004 must be left alone. */
1007 free_menubar_widget_value_tree (wv
)
1012 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1014 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1016 free_menubar_widget_value_tree (wv
->contents
);
1017 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1021 free_menubar_widget_value_tree (wv
->next
);
1022 wv
->next
= (widget_value
*) 0xDEADBEEF;
1025 free_widget_value (wv
);
1029 /* Set up data in menu_items for a menu bar item
1030 whose event type is ITEM_KEY (with string ITEM_NAME)
1031 and whose contents come from the list of keymaps MAPS. */
1034 parse_single_submenu (item_key
, item_name
, maps
)
1035 Lisp_Object item_key
, item_name
, maps
;
1039 Lisp_Object
*mapvec
;
1041 int top_level_items
= 0;
1043 length
= Flength (maps
);
1044 len
= XINT (length
);
1046 /* Convert the list MAPS into a vector MAPVEC. */
1047 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1048 for (i
= 0; i
< len
; i
++)
1050 mapvec
[i
] = Fcar (maps
);
1054 /* Loop over the given keymaps, making a pane for each map.
1055 But don't make a pane that is empty--ignore that map instead. */
1056 for (i
= 0; i
< len
; i
++)
1058 if (!KEYMAPP (mapvec
[i
]))
1060 /* Here we have a command at top level in the menu bar
1061 as opposed to a submenu. */
1062 top_level_items
= 1;
1063 push_menu_pane (Qnil
, Qnil
);
1064 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1065 Qnil
, Qnil
, Qnil
, Qnil
);
1070 prompt
= Fkeymap_prompt (mapvec
[i
]);
1071 single_keymap_panes (mapvec
[i
],
1072 !NILP (prompt
) ? prompt
: item_name
,
1077 return top_level_items
;
1080 /* Create a tree of widget_value objects
1081 representing the panes and items
1082 in menu_items starting at index START, up to index END. */
1084 static widget_value
*
1085 digest_single_submenu (start
, end
, top_level_items
)
1086 int start
, end
, top_level_items
;
1088 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1090 int submenu_depth
= 0;
1091 widget_value
**submenu_stack
;
1095 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1096 wv
= xmalloc_widget_value ();
1100 wv
->button_type
= BUTTON_TYPE_NONE
;
1106 /* Loop over all panes and items made by the preceding call
1107 to parse_single_submenu and construct a tree of widget_value objects.
1108 Ignore the panes and items used by previous calls to
1109 digest_single_submenu, even though those are also in menu_items. */
1113 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1115 submenu_stack
[submenu_depth
++] = save_wv
;
1120 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1123 save_wv
= submenu_stack
[--submenu_depth
];
1126 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1127 && submenu_depth
!= 0)
1128 i
+= MENU_ITEMS_PANE_LENGTH
;
1129 /* Ignore a nil in the item list.
1130 It's meaningful only for dialog boxes. */
1131 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1133 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1135 /* Create a new pane. */
1136 Lisp_Object pane_name
, prefix
;
1141 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1142 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1144 #ifndef HAVE_MULTILINGUAL_MENU
1145 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1147 pane_name
= ENCODE_MENU_STRING (pane_name
);
1148 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1151 pane_string
= (NILP (pane_name
)
1152 ? "" : (char *) SDATA (pane_name
));
1153 /* If there is just one top-level pane, put all its items directly
1154 under the top-level menu. */
1155 if (menu_items_n_panes
== 1)
1158 /* If the pane has a meaningful name,
1159 make the pane a top-level menu item
1160 with its items as a submenu beneath it. */
1161 if (strcmp (pane_string
, ""))
1163 wv
= xmalloc_widget_value ();
1167 first_wv
->contents
= wv
;
1168 wv
->lname
= pane_name
;
1169 /* Set value to 1 so update_submenu_strings can handle '@' */
1170 wv
->value
= (char *)1;
1172 wv
->button_type
= BUTTON_TYPE_NONE
;
1180 i
+= MENU_ITEMS_PANE_LENGTH
;
1184 /* Create a new item within current pane. */
1185 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1188 /* All items should be contained in panes. */
1189 if (panes_seen
== 0)
1192 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1193 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1194 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1195 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1196 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1197 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1198 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1200 #ifndef HAVE_MULTILINGUAL_MENU
1201 if (STRING_MULTIBYTE (item_name
))
1203 item_name
= ENCODE_MENU_STRING (item_name
);
1204 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1207 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1209 descrip
= ENCODE_MENU_STRING (descrip
);
1210 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1212 #endif /* not HAVE_MULTILINGUAL_MENU */
1214 wv
= xmalloc_widget_value ();
1218 save_wv
->contents
= wv
;
1220 wv
->lname
= item_name
;
1221 if (!NILP (descrip
))
1224 /* The EMACS_INT cast avoids a warning. There's no problem
1225 as long as pointers have enough bits to hold small integers. */
1226 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1227 wv
->enabled
= !NILP (enable
);
1230 wv
->button_type
= BUTTON_TYPE_NONE
;
1231 else if (EQ (type
, QCradio
))
1232 wv
->button_type
= BUTTON_TYPE_RADIO
;
1233 else if (EQ (type
, QCtoggle
))
1234 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1238 wv
->selected
= !NILP (selected
);
1239 if (! STRINGP (help
))
1246 i
+= MENU_ITEMS_ITEM_LENGTH
;
1250 /* If we have just one "menu item"
1251 that was originally a button, return it by itself. */
1252 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1254 wv
= first_wv
->contents
;
1255 free_widget_value (first_wv
);
1262 /* Walk through the widget_value tree starting at FIRST_WV and update
1263 the char * pointers from the corresponding lisp values.
1264 We do this after building the whole tree, since GC may happen while the
1265 tree is constructed, and small strings are relocated. So we must wait
1266 until no GC can happen before storing pointers into lisp values. */
1268 update_submenu_strings (first_wv
)
1269 widget_value
*first_wv
;
1273 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1275 if (STRINGP (wv
->lname
))
1277 wv
->name
= SDATA (wv
->lname
);
1279 /* Ignore the @ that means "separate pane".
1280 This is a kludge, but this isn't worth more time. */
1281 if (wv
->value
== (char *)1)
1283 if (wv
->name
[0] == '@')
1289 if (STRINGP (wv
->lkey
))
1290 wv
->key
= SDATA (wv
->lkey
);
1293 update_submenu_strings (wv
->contents
);
1298 /* Set the contents of the menubar widgets of frame F.
1299 The argument FIRST_TIME is currently ignored;
1300 it is set the first time this is called, from initialize_frame_menubar. */
1303 set_frame_menubar (f
, first_time
, deep_p
)
1308 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1310 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1312 int *submenu_start
, *submenu_end
;
1313 int *submenu_top_level_items
, *submenu_n_panes
;
1315 XSETFRAME (Vmenu_updating_frame
, f
);
1317 /* This seems to be unnecessary for Carbon. */
1319 if (! menubar_widget
)
1321 else if (pending_menu_activation
&& !deep_p
)
1327 /* Make a widget-value tree representing the entire menu trees. */
1329 struct buffer
*prev
= current_buffer
;
1331 int specpdl_count
= SPECPDL_INDEX ();
1332 int previous_menu_items_used
= f
->menu_bar_items_used
;
1333 Lisp_Object
*previous_items
1334 = (Lisp_Object
*) alloca (previous_menu_items_used
1335 * sizeof (Lisp_Object
));
1337 /* If we are making a new widget, its contents are empty,
1338 do always reinitialize them. */
1339 if (! menubar_widget
)
1340 previous_menu_items_used
= 0;
1342 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1343 specbind (Qinhibit_quit
, Qt
);
1344 /* Don't let the debugger step into this code
1345 because it is not reentrant. */
1346 specbind (Qdebug_on_next_call
, Qnil
);
1348 record_unwind_save_match_data ();
1349 if (NILP (Voverriding_local_map_menu_flag
))
1351 specbind (Qoverriding_terminal_local_map
, Qnil
);
1352 specbind (Qoverriding_local_map
, Qnil
);
1355 set_buffer_internal_1 (XBUFFER (buffer
));
1357 /* Run the Lucid hook. */
1358 safe_run_hooks (Qactivate_menubar_hook
);
1360 /* If it has changed current-menubar from previous value,
1361 really recompute the menubar from the value. */
1362 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1363 call0 (Qrecompute_lucid_menubar
);
1364 safe_run_hooks (Qmenu_bar_update_hook
);
1365 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1367 items
= FRAME_MENU_BAR_ITEMS (f
);
1369 /* Save the frame's previous menu bar contents data. */
1370 if (previous_menu_items_used
)
1371 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1372 previous_menu_items_used
* sizeof (Lisp_Object
));
1374 /* Fill in menu_items with the current menu bar contents.
1375 This can evaluate Lisp code. */
1378 menu_items
= f
->menu_bar_vector
;
1379 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1380 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1381 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1382 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1383 submenu_top_level_items
1384 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1386 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1388 Lisp_Object key
, string
, maps
;
1392 key
= XVECTOR (items
)->contents
[i
];
1393 string
= XVECTOR (items
)->contents
[i
+ 1];
1394 maps
= XVECTOR (items
)->contents
[i
+ 2];
1398 submenu_start
[i
] = menu_items_used
;
1400 menu_items_n_panes
= 0;
1401 submenu_top_level_items
[i
]
1402 = parse_single_submenu (key
, string
, maps
);
1403 submenu_n_panes
[i
] = menu_items_n_panes
;
1405 submenu_end
[i
] = menu_items_used
;
1408 finish_menu_items ();
1410 /* Convert menu_items into widget_value trees
1411 to display the menu. This cannot evaluate Lisp code. */
1413 wv
= xmalloc_widget_value ();
1414 wv
->name
= "menubar";
1417 wv
->button_type
= BUTTON_TYPE_NONE
;
1421 for (i
= 0; i
< last_i
; i
+= 4)
1423 menu_items_n_panes
= submenu_n_panes
[i
];
1424 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1425 submenu_top_level_items
[i
]);
1429 first_wv
->contents
= wv
;
1430 /* Don't set wv->name here; GC during the loop might relocate it. */
1432 wv
->button_type
= BUTTON_TYPE_NONE
;
1436 set_buffer_internal_1 (prev
);
1438 /* If there has been no change in the Lisp-level contents
1439 of the menu bar, skip redisplaying it. Just exit. */
1441 /* Compare the new menu items with the ones computed last time. */
1442 for (i
= 0; i
< previous_menu_items_used
; i
++)
1443 if (menu_items_used
== i
1444 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1446 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1448 /* The menu items have not changed. Don't bother updating
1449 the menus in any form, since it would be a no-op. */
1450 free_menubar_widget_value_tree (first_wv
);
1451 discard_menu_items ();
1452 unbind_to (specpdl_count
, Qnil
);
1456 /* The menu items are different, so store them in the frame. */
1457 f
->menu_bar_vector
= menu_items
;
1458 f
->menu_bar_items_used
= menu_items_used
;
1460 /* This calls restore_menu_items to restore menu_items, etc.,
1461 as they were outside. */
1462 unbind_to (specpdl_count
, Qnil
);
1464 /* Now GC cannot happen during the lifetime of the widget_value,
1465 so it's safe to store data from a Lisp_String. */
1466 wv
= first_wv
->contents
;
1467 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1470 string
= XVECTOR (items
)->contents
[i
+ 1];
1473 wv
->name
= (char *) SDATA (string
);
1474 update_submenu_strings (wv
->contents
);
1481 /* Make a widget-value tree containing
1482 just the top level menu bar strings. */
1484 wv
= xmalloc_widget_value ();
1485 wv
->name
= "menubar";
1488 wv
->button_type
= BUTTON_TYPE_NONE
;
1492 items
= FRAME_MENU_BAR_ITEMS (f
);
1493 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1497 string
= XVECTOR (items
)->contents
[i
+ 1];
1501 wv
= xmalloc_widget_value ();
1502 wv
->name
= (char *) SDATA (string
);
1505 wv
->button_type
= BUTTON_TYPE_NONE
;
1507 /* This prevents lwlib from assuming this
1508 menu item is really supposed to be empty. */
1509 /* The EMACS_INT cast avoids a warning.
1510 This value just has to be different from small integers. */
1511 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1516 first_wv
->contents
= wv
;
1520 /* Forget what we thought we knew about what is in the
1521 detailed contents of the menu bar menus.
1522 Changing the top level always destroys the contents. */
1523 f
->menu_bar_items_used
= 0;
1526 /* Create or update the menu bar widget. */
1530 /* Non-null value to indicate menubar has already been "created". */
1531 f
->output_data
.mac
->menubar_widget
= 1;
1533 mac_fill_menubar (first_wv
->contents
, deep_p
);
1535 free_menubar_widget_value_tree (first_wv
);
1540 /* Get rid of the menu bar of frame F, and free its storage.
1541 This is used when deleting a frame, and when turning off the menu bar. */
1544 free_frame_menubar (f
)
1547 f
->output_data
.mac
->menubar_widget
= 0;
1551 /* The item selected in the popup menu. */
1552 int menu_item_selection
;
1554 /* Mac_menu_show actually displays a menu using the panes and items in
1555 menu_items and returns the value selected from it; we assume input
1556 is blocked by the caller. */
1558 /* F is the frame the menu is for.
1559 X and Y are the frame-relative specified position,
1560 relative to the inside upper left corner of the frame F.
1561 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1562 KEYMAPS is 1 if this menu was specified with keymaps;
1563 in that case, we return a list containing the chosen item's value
1564 and perhaps also the pane's prefix.
1565 TITLE is the specified menu title.
1566 ERROR is a place to store an error message string in case of failure.
1567 (We return nil on failure, but the value doesn't actually matter.) */
1570 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1580 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1581 widget_value
**submenu_stack
1582 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1583 Lisp_Object
*subprefix_stack
1584 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1585 int submenu_depth
= 0;
1591 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1593 *error
= "Empty menu";
1597 /* Create a tree of widget_value objects
1598 representing the panes and their items. */
1599 wv
= xmalloc_widget_value ();
1603 wv
->button_type
= BUTTON_TYPE_NONE
;
1608 /* Loop over all panes and items, filling in the tree. */
1610 while (i
< menu_items_used
)
1612 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1614 submenu_stack
[submenu_depth
++] = save_wv
;
1620 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1623 save_wv
= submenu_stack
[--submenu_depth
];
1627 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1628 && submenu_depth
!= 0)
1629 i
+= MENU_ITEMS_PANE_LENGTH
;
1630 /* Ignore a nil in the item list.
1631 It's meaningful only for dialog boxes. */
1632 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1634 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1636 /* Create a new pane. */
1637 Lisp_Object pane_name
, prefix
;
1640 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1641 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1643 #ifndef HAVE_MULTILINGUAL_MENU
1644 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1646 pane_name
= ENCODE_MENU_STRING (pane_name
);
1647 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1650 pane_string
= (NILP (pane_name
)
1651 ? "" : (char *) SDATA (pane_name
));
1652 /* If there is just one top-level pane, put all its items directly
1653 under the top-level menu. */
1654 if (menu_items_n_panes
== 1)
1657 /* If the pane has a meaningful name,
1658 make the pane a top-level menu item
1659 with its items as a submenu beneath it. */
1660 if (!keymaps
&& strcmp (pane_string
, ""))
1662 wv
= xmalloc_widget_value ();
1666 first_wv
->contents
= wv
;
1667 wv
->name
= pane_string
;
1668 if (keymaps
&& !NILP (prefix
))
1672 wv
->button_type
= BUTTON_TYPE_NONE
;
1677 else if (first_pane
)
1683 i
+= MENU_ITEMS_PANE_LENGTH
;
1687 /* Create a new item within current pane. */
1688 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1689 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1690 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1691 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1692 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1693 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1694 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1695 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1697 #ifndef HAVE_MULTILINGUAL_MENU
1698 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1700 item_name
= ENCODE_MENU_STRING (item_name
);
1701 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1704 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1706 descrip
= ENCODE_MENU_STRING (descrip
);
1707 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1709 #endif /* not HAVE_MULTILINGUAL_MENU */
1711 wv
= xmalloc_widget_value ();
1715 save_wv
->contents
= wv
;
1716 wv
->name
= (char *) SDATA (item_name
);
1717 if (!NILP (descrip
))
1718 wv
->key
= (char *) SDATA (descrip
);
1720 /* Use the contents index as call_data, since we are
1721 restricted to 16-bits. */
1722 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1723 wv
->enabled
= !NILP (enable
);
1726 wv
->button_type
= BUTTON_TYPE_NONE
;
1727 else if (EQ (type
, QCtoggle
))
1728 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1729 else if (EQ (type
, QCradio
))
1730 wv
->button_type
= BUTTON_TYPE_RADIO
;
1734 wv
->selected
= !NILP (selected
);
1736 if (! STRINGP (help
))
1743 i
+= MENU_ITEMS_ITEM_LENGTH
;
1747 /* Deal with the title, if it is non-nil. */
1750 widget_value
*wv_title
= xmalloc_widget_value ();
1751 widget_value
*wv_sep
= xmalloc_widget_value ();
1753 /* Maybe replace this separator with a bitmap or owner-draw item
1754 so that it looks better. Having two separators looks odd. */
1755 wv_sep
->name
= "--";
1756 wv_sep
->next
= first_wv
->contents
;
1757 wv_sep
->help
= Qnil
;
1759 #ifndef HAVE_MULTILINGUAL_MENU
1760 if (STRING_MULTIBYTE (title
))
1761 title
= ENCODE_MENU_STRING (title
);
1764 wv_title
->name
= (char *) SDATA (title
);
1765 wv_title
->enabled
= FALSE
;
1766 wv_title
->title
= TRUE
;
1767 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1768 wv_title
->help
= Qnil
;
1769 wv_title
->next
= wv_sep
;
1770 first_wv
->contents
= wv_title
;
1773 /* No selection has been chosen yet. */
1774 menu_item_selection
= 0;
1776 /* Actually create and show the menu until popped down. */
1777 create_and_show_popup_menu (f
, first_wv
, x
, y
, for_click
);
1779 /* Free the widget_value objects we used to specify the contents. */
1780 free_menubar_widget_value_tree (first_wv
);
1782 /* Find the selected item, and its pane, to return
1783 the proper value. */
1784 if (menu_item_selection
!= 0)
1786 Lisp_Object prefix
, entry
;
1788 prefix
= entry
= Qnil
;
1790 while (i
< menu_items_used
)
1792 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1794 subprefix_stack
[submenu_depth
++] = prefix
;
1798 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1800 prefix
= subprefix_stack
[--submenu_depth
];
1803 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1806 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1807 i
+= MENU_ITEMS_PANE_LENGTH
;
1809 /* Ignore a nil in the item list.
1810 It's meaningful only for dialog boxes. */
1811 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1816 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1817 if (menu_item_selection
== i
)
1823 entry
= Fcons (entry
, Qnil
);
1825 entry
= Fcons (prefix
, entry
);
1826 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1827 if (!NILP (subprefix_stack
[j
]))
1828 entry
= Fcons (subprefix_stack
[j
], entry
);
1832 i
+= MENU_ITEMS_ITEM_LENGTH
;
1836 else if (!for_click
)
1837 /* Make "Cancel" equivalent to C-g. */
1838 Fsignal (Qquit
, Qnil
);
1845 /* Construct native Mac OS dialog based on widget_value tree. */
1847 static char * button_names
[] = {
1848 "button1", "button2", "button3", "button4", "button5",
1849 "button6", "button7", "button8", "button9", "button10" };
1852 mac_dialog_show (f
, keymaps
, title
, header
, error_name
)
1855 Lisp_Object title
, header
;
1858 int i
, nb_buttons
=0;
1859 char dialog_name
[6];
1861 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1863 /* Number of elements seen so far, before boundary. */
1865 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1866 int boundary_seen
= 0;
1870 if (menu_items_n_panes
> 1)
1872 *error_name
= "Multiple panes in dialog box";
1876 /* Create a tree of widget_value objects
1877 representing the text label and buttons. */
1879 Lisp_Object pane_name
, prefix
;
1881 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1882 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1883 pane_string
= (NILP (pane_name
)
1884 ? "" : (char *) SDATA (pane_name
));
1885 prev_wv
= xmalloc_widget_value ();
1886 prev_wv
->value
= pane_string
;
1887 if (keymaps
&& !NILP (prefix
))
1889 prev_wv
->enabled
= 1;
1890 prev_wv
->name
= "message";
1891 prev_wv
->help
= Qnil
;
1894 /* Loop over all panes and items, filling in the tree. */
1895 i
= MENU_ITEMS_PANE_LENGTH
;
1896 while (i
< menu_items_used
)
1899 /* Create a new item within current pane. */
1900 Lisp_Object item_name
, enable
, descrip
;
1901 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1902 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1904 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1906 if (NILP (item_name
))
1908 free_menubar_widget_value_tree (first_wv
);
1909 *error_name
= "Submenu in dialog items";
1912 if (EQ (item_name
, Qquote
))
1914 /* This is the boundary between left-side elts
1915 and right-side elts. Stop incrementing right_count. */
1920 if (nb_buttons
>= 9)
1922 free_menubar_widget_value_tree (first_wv
);
1923 *error_name
= "Too many dialog items";
1927 wv
= xmalloc_widget_value ();
1929 wv
->name
= (char *) button_names
[nb_buttons
];
1930 if (!NILP (descrip
))
1931 wv
->key
= (char *) SDATA (descrip
);
1932 wv
->value
= (char *) SDATA (item_name
);
1933 wv
->call_data
= (void *) i
;
1934 /* menu item is identified by its index in menu_items table */
1935 wv
->enabled
= !NILP (enable
);
1939 if (! boundary_seen
)
1943 i
+= MENU_ITEMS_ITEM_LENGTH
;
1946 /* If the boundary was not specified,
1947 by default put half on the left and half on the right. */
1948 if (! boundary_seen
)
1949 left_count
= nb_buttons
- nb_buttons
/ 2;
1951 wv
= xmalloc_widget_value ();
1952 wv
->name
= dialog_name
;
1955 /* Frame title: 'Q' = Question, 'I' = Information.
1956 Can also have 'E' = Error if, one day, we want
1957 a popup for errors. */
1959 dialog_name
[0] = 'Q';
1961 dialog_name
[0] = 'I';
1963 /* Dialog boxes use a really stupid name encoding
1964 which specifies how many buttons to use
1965 and how many buttons are on the right. */
1966 dialog_name
[1] = '0' + nb_buttons
;
1967 dialog_name
[2] = 'B';
1968 dialog_name
[3] = 'R';
1969 /* Number of buttons to put on the right. */
1970 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1972 wv
->contents
= first_wv
;
1976 /* No selection has been chosen yet. */
1977 menu_item_selection
= 0;
1979 /* Force a redisplay before showing the dialog. If a frame is created
1980 just before showing the dialog, its contents may not have been fully
1984 /* Actually create the dialog. */
1985 #if TARGET_API_MAC_CARBON
1986 create_and_show_dialog (f
, first_wv
);
1988 menu_item_selection
= mac_dialog (first_wv
);
1991 /* Free the widget_value objects we used to specify the contents. */
1992 free_menubar_widget_value_tree (first_wv
);
1994 /* Find the selected item, and its pane, to return
1995 the proper value. */
1996 if (menu_item_selection
!= 0)
2002 while (i
< menu_items_used
)
2006 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2009 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2010 i
+= MENU_ITEMS_PANE_LENGTH
;
2012 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2014 /* This is the boundary between left-side elts and
2021 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2022 if (menu_item_selection
== i
)
2026 entry
= Fcons (entry
, Qnil
);
2028 entry
= Fcons (prefix
, entry
);
2032 i
+= MENU_ITEMS_ITEM_LENGTH
;
2037 /* Make "Cancel" equivalent to C-g. */
2038 Fsignal (Qquit
, Qnil
);
2042 #endif /* HAVE_DIALOGS */
2045 /* Is this item a separator? */
2047 name_is_separator (name
)
2050 const char *start
= name
;
2052 /* Check if name string consists of only dashes ('-'). */
2053 while (*name
== '-') name
++;
2054 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2055 or "--deep-shadow". We don't implement them yet, se we just treat
2056 them like normal separators. */
2057 return (*name
== '\0' || start
+ 2 == name
);
2059 #endif /* HAVE_MENUS */
2061 /* Detect if a menu is currently active. */
2066 return popup_activated_flag
;
2069 /* The following is used by delayed window autoselection. */
2071 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2072 doc
: /* Return t if a menu or popup dialog is active. */)
2075 #if TARGET_API_MAC_CARBON
2076 return (popup_activated ()) ? Qt
: Qnil
;
2078 /* Always return Qnil since menu selection functions do not return
2079 until a selection has been made or cancelled. */
2087 staticpro (&menu_items
);
2090 Qdebug_on_next_call
= intern ("debug-on-next-call");
2091 staticpro (&Qdebug_on_next_call
);
2093 defsubr (&Sx_popup_menu
);
2094 defsubr (&Smenu_or_popup_active_p
);
2096 defsubr (&Sx_popup_dialog
);
2100 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2101 (do not change this comment) */