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). */
30 #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. */
252 menu_items_allocated
*= 2;
253 menu_items
= larger_vector (menu_items
, menu_items_allocated
, Qnil
);
256 /* Begin a submenu. */
259 push_submenu_start ()
261 if (menu_items_used
+ 1 > menu_items_allocated
)
264 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
265 menu_items_submenu_depth
++;
273 if (menu_items_used
+ 1 > menu_items_allocated
)
276 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
277 menu_items_submenu_depth
--;
280 /* Indicate boundary between left and right. */
283 push_left_right_boundary ()
285 if (menu_items_used
+ 1 > menu_items_allocated
)
288 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
291 /* Start a new menu pane in menu_items.
292 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
295 push_menu_pane (name
, prefix_vec
)
296 Lisp_Object name
, prefix_vec
;
298 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
301 if (menu_items_submenu_depth
== 0)
302 menu_items_n_panes
++;
303 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
304 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
305 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
308 /* Push one menu item into the current pane. NAME is the string to
309 display. ENABLE if non-nil means this item can be selected. KEY
310 is the key generated by choosing this item, or nil if this item
311 doesn't really have a definition. DEF is the definition of this
312 item. EQUIV is the textual description of the keyboard equivalent
313 for this item (or nil if none). TYPE is the type of this menu
314 item, one of nil, `toggle' or `radio'. */
317 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
318 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
320 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
323 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
324 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
325 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
326 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
327 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
328 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
329 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
330 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
333 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
334 and generate menu panes for them in menu_items.
335 If NOTREAL is nonzero,
336 don't bother really computing whether an item is enabled. */
339 keymap_panes (keymaps
, nmaps
, notreal
)
340 Lisp_Object
*keymaps
;
348 /* Loop over the given keymaps, making a pane for each map.
349 But don't make a pane that is empty--ignore that map instead.
350 P is the number of panes we have made so far. */
351 for (mapno
= 0; mapno
< nmaps
; mapno
++)
352 single_keymap_panes (keymaps
[mapno
],
353 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
355 finish_menu_items ();
358 /* Args passed between single_keymap_panes and single_menu_item. */
361 Lisp_Object pending_maps
;
362 int maxdepth
, notreal
;
365 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
368 /* This is a recursive subroutine of keymap_panes.
369 It handles one keymap, KEYMAP.
370 The other arguments are passed along
371 or point to local variables of the previous function.
372 If NOTREAL is nonzero, only check for equivalent key bindings, don't
373 evaluate expressions in menu items and don't make any menu.
375 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
378 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
380 Lisp_Object pane_name
;
388 skp
.pending_maps
= Qnil
;
389 skp
.maxdepth
= maxdepth
;
390 skp
.notreal
= notreal
;
395 push_menu_pane (pane_name
, prefix
);
397 GCPRO1 (skp
.pending_maps
);
398 map_keymap (keymap
, single_menu_item
, Qnil
, &skp
, 1);
401 /* Process now any submenus which want to be panes at this level. */
402 while (CONSP (skp
.pending_maps
))
404 Lisp_Object elt
, eltcdr
, string
;
405 elt
= XCAR (skp
.pending_maps
);
407 string
= XCAR (eltcdr
);
408 /* We no longer discard the @ from the beginning of the string here.
409 Instead, we do this in mac_menu_show. */
410 single_keymap_panes (Fcar (elt
), string
,
411 XCDR (eltcdr
), notreal
, maxdepth
- 1);
412 skp
.pending_maps
= XCDR (skp
.pending_maps
);
416 /* This is a subroutine of single_keymap_panes that handles one
418 KEY is a key in a keymap and ITEM is its binding.
419 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
421 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
422 evaluate expressions in menu items and don't make any menu.
423 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
426 single_menu_item (key
, item
, dummy
, skp_v
)
427 Lisp_Object key
, item
, dummy
;
430 Lisp_Object map
, item_string
, enabled
;
431 struct gcpro gcpro1
, gcpro2
;
433 struct skp
*skp
= skp_v
;
435 /* Parse the menu item and leave the result in item_properties. */
437 res
= parse_menu_item (item
, skp
->notreal
, 0);
440 return; /* Not a menu item. */
442 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
446 /* We don't want to make a menu, just traverse the keymaps to
447 precompute equivalent key bindings. */
449 single_keymap_panes (map
, Qnil
, key
, 1, skp
->maxdepth
- 1);
453 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
454 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
456 if (!NILP (map
) && SREF (item_string
, 0) == '@')
459 /* An enabled separate pane. Remember this to handle it later. */
460 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
465 push_menu_item (item_string
, enabled
, key
,
466 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
467 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
468 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
469 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
470 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
472 /* Display a submenu using the toolkit. */
473 if (! (NILP (map
) || NILP (enabled
)))
475 push_submenu_start ();
476 single_keymap_panes (map
, Qnil
, key
, 0, skp
->maxdepth
- 1);
481 /* Push all the panes and items of a menu described by the
482 alist-of-alists MENU.
483 This handles old-fashioned calls to x-popup-menu. */
493 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
495 Lisp_Object elt
, pane_name
, pane_data
;
497 pane_name
= Fcar (elt
);
498 CHECK_STRING (pane_name
);
499 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
500 pane_data
= Fcdr (elt
);
501 CHECK_CONS (pane_data
);
502 list_of_items (pane_data
);
505 finish_menu_items ();
508 /* Push the items in a single pane defined by the alist PANE. */
514 Lisp_Object tail
, item
, item1
;
516 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
520 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
521 Qnil
, Qnil
, Qnil
, Qnil
);
522 else if (CONSP (item
))
525 CHECK_STRING (item1
);
526 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
527 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
530 push_left_right_boundary ();
536 cleanup_popup_menu (arg
)
539 discard_menu_items ();
543 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
544 doc
: /* Pop up a deck-of-cards menu and return user's selection.
545 POSITION is a position specification. This is either a mouse button event
546 or a list ((XOFFSET YOFFSET) WINDOW)
547 where XOFFSET and YOFFSET are positions in pixels from the top left
548 corner of WINDOW. (WINDOW may be a window or a frame object.)
549 This controls the position of the top left of the menu as a whole.
550 If POSITION is t, it means to use the current mouse position.
552 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
553 The menu items come from key bindings that have a menu string as well as
554 a definition; actually, the "definition" in such a key binding looks like
555 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
556 the keymap as a top-level element.
558 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
559 Otherwise, REAL-DEFINITION should be a valid key binding definition.
561 You can also use a list of keymaps as MENU.
562 Then each keymap makes a separate pane.
564 When MENU is a keymap or a list of keymaps, the return value is the
565 list of events corresponding to the user's choice. Note that
566 `x-popup-menu' does not actually execute the command bound to that
569 Alternatively, you can specify a menu of multiple panes
570 with a list of the form (TITLE PANE1 PANE2...),
571 where each pane is a list of form (TITLE ITEM1 ITEM2...).
572 Each ITEM is normally a cons cell (STRING . VALUE);
573 but a string can appear as an item--that makes a nonselectable line
575 With this form of menu, the return value is VALUE from the chosen item.
577 If POSITION is nil, don't display the menu at all, just precalculate the
578 cached information about equivalent key sequences.
580 If the user gets rid of the menu without making a valid choice, for
581 instance by clicking the mouse away from a valid choice or by typing
582 keyboard input, then this normally results in a quit and
583 `x-popup-menu' does not return. But if POSITION is a mouse button
584 event (indicating that the user invoked the menu with the mouse) then
585 no quit occurs and `x-popup-menu' returns nil. */)
587 Lisp_Object position
, menu
;
589 Lisp_Object keymap
, tem
;
590 int xpos
= 0, ypos
= 0;
592 char *error_name
= NULL
;
593 Lisp_Object selection
;
595 Lisp_Object x
, y
, window
;
598 int specpdl_count
= SPECPDL_INDEX ();
602 if (! NILP (position
))
606 /* Decode the first argument: find the window and the coordinates. */
607 if (EQ (position
, Qt
)
608 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
609 || EQ (XCAR (position
), Qtool_bar
)
610 || EQ (XCAR (position
), Qmac_apple_event
))))
612 /* Use the mouse's current position. */
613 FRAME_PTR new_f
= SELECTED_FRAME ();
614 Lisp_Object bar_window
;
615 enum scroll_bar_part part
;
618 if (FRAME_TERMINAL (new_f
)->mouse_position_hook
)
619 (*FRAME_TERMINAL (new_f
)->mouse_position_hook
) (&new_f
, 1, &bar_window
,
620 &part
, &x
, &y
, &time
);
622 XSETFRAME (window
, new_f
);
625 window
= selected_window
;
632 tem
= Fcar (position
);
635 window
= Fcar (Fcdr (position
));
637 y
= Fcar (XCDR (tem
));
642 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
643 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
644 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
653 /* Decode where to put the menu. */
661 else if (WINDOWP (window
))
663 CHECK_LIVE_WINDOW (window
);
664 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
666 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
667 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
670 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
671 but I don't want to make one now. */
672 CHECK_WINDOW (window
);
677 XSETFRAME (Vmenu_updating_frame
, f
);
680 Vmenu_updating_frame
= Qnil
;
681 #endif /* HAVE_MENUS */
686 /* Decode the menu items from what was specified. */
688 keymap
= get_keymap (menu
, 0, 0);
691 /* We were given a keymap. Extract menu info from the keymap. */
694 /* Extract the detailed info to make one pane. */
695 keymap_panes (&menu
, 1, NILP (position
));
697 /* Search for a string appearing directly as an element of the keymap.
698 That string is the title of the menu. */
699 prompt
= Fkeymap_prompt (keymap
);
700 if (NILP (title
) && !NILP (prompt
))
703 /* Make that be the pane title of the first pane. */
704 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
705 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
709 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
711 /* We were given a list of keymaps. */
712 int nmaps
= XFASTINT (Flength (menu
));
714 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
719 /* The first keymap that has a prompt string
720 supplies the menu title. */
721 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
725 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
727 prompt
= Fkeymap_prompt (keymap
);
728 if (NILP (title
) && !NILP (prompt
))
732 /* Extract the detailed info to make one pane. */
733 keymap_panes (maps
, nmaps
, NILP (position
));
735 /* Make the title be the pane title of the first pane. */
736 if (!NILP (title
) && menu_items_n_panes
>= 0)
737 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
743 /* We were given an old-fashioned menu. */
745 CHECK_STRING (title
);
747 list_of_panes (Fcdr (menu
));
754 discard_menu_items ();
760 /* Display them in a menu. */
761 record_unwind_protect (cleanup_popup_menu
, Qnil
);
764 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
765 keymaps
, title
, &error_name
);
767 unbind_to (specpdl_count
, Qnil
);
770 #endif /* HAVE_MENUS */
772 if (error_name
) error (error_name
);
778 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
779 doc
: /* Pop up a dialog box and return user's selection.
780 POSITION specifies which frame to use.
781 This is normally a mouse button event or a window or frame.
782 If POSITION is t, it means to use the frame the mouse is on.
783 The dialog box appears in the middle of the specified frame.
785 CONTENTS specifies the alternatives to display in the dialog box.
786 It is a list of the form (DIALOG ITEM1 ITEM2...).
787 Each ITEM is a cons cell (STRING . VALUE).
788 The return value is VALUE from the chosen item.
790 An ITEM may also be just a string--that makes a nonselectable item.
791 An ITEM may also be nil--that means to put all preceding items
792 on the left of the dialog box and all following items on the right.
793 \(By default, approximately half appear on each side.)
795 If HEADER is non-nil, the frame title for the box is "Information",
796 otherwise it is "Question".
798 If the user gets rid of the dialog box without making a valid choice,
799 for instance using the window manager, then this produces a quit and
800 `x-popup-dialog' does not return. */)
801 (position
, contents
, header
)
802 Lisp_Object position
, contents
, header
;
809 /* Decode the first argument: find the window or frame to use. */
810 if (EQ (position
, Qt
)
811 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
812 || EQ (XCAR (position
), Qtool_bar
)
813 || EQ (XCAR (position
), Qmac_apple_event
))))
815 #if 0 /* Using the frame the mouse is on may not be right. */
816 /* Use the mouse's current position. */
817 FRAME_PTR new_f
= SELECTED_FRAME ();
818 Lisp_Object bar_window
;
819 enum scroll_bar_part part
;
823 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
826 XSETFRAME (window
, new_f
);
828 window
= selected_window
;
830 window
= selected_window
;
832 else if (CONSP (position
))
835 tem
= Fcar (position
);
837 window
= Fcar (Fcdr (position
));
840 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
841 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
844 else if (WINDOWP (position
) || FRAMEP (position
))
849 /* Decode where to put the menu. */
853 else if (WINDOWP (window
))
855 CHECK_LIVE_WINDOW (window
);
856 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
859 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
860 but I don't want to make one now. */
861 CHECK_WINDOW (window
);
864 /* Display a menu with these alternatives
865 in the middle of frame F. */
867 Lisp_Object x
, y
, frame
, newpos
;
868 XSETFRAME (frame
, f
);
869 XSETINT (x
, x_pixel_width (f
) / 2);
870 XSETINT (y
, x_pixel_height (f
) / 2);
871 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
873 return Fx_popup_menu (newpos
,
874 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
876 #else /* HAVE_DIALOGS */
880 Lisp_Object selection
;
881 int specpdl_count
= SPECPDL_INDEX ();
883 /* Decode the dialog items from what was specified. */
884 title
= Fcar (contents
);
885 CHECK_STRING (title
);
887 list_of_panes (Fcons (contents
, Qnil
));
889 /* Display them in a dialog box. */
890 record_unwind_protect (cleanup_popup_menu
, Qnil
);
892 selection
= mac_dialog_show (f
, 0, title
, header
, &error_name
);
894 unbind_to (specpdl_count
, Qnil
);
896 if (error_name
) error (error_name
);
899 #endif /* HAVE_DIALOGS */
902 /* Find the menu selection and store it in the keyboard buffer.
903 F is the frame the menu is on.
904 MENU_BAR_ITEMS_USED is the length of VECTOR.
905 VECTOR is an array of menu events for the whole menu. */
908 find_and_call_menu_selection (f
, menu_bar_items_used
, vector
, client_data
)
910 int menu_bar_items_used
;
914 Lisp_Object prefix
, entry
;
915 Lisp_Object
*subprefix_stack
;
916 int submenu_depth
= 0;
920 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
924 while (i
< menu_bar_items_used
)
926 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
928 subprefix_stack
[submenu_depth
++] = prefix
;
932 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
934 prefix
= subprefix_stack
[--submenu_depth
];
937 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
939 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
940 i
+= MENU_ITEMS_PANE_LENGTH
;
944 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
945 /* The EMACS_INT cast avoids a warning. There's no problem
946 as long as pointers have enough bits to hold small integers. */
947 if ((int) (EMACS_INT
) client_data
== i
)
950 struct input_event buf
;
954 XSETFRAME (frame
, f
);
955 buf
.kind
= MENU_BAR_EVENT
;
956 buf
.frame_or_window
= frame
;
958 kbd_buffer_store_event (&buf
);
960 for (j
= 0; j
< submenu_depth
; j
++)
961 if (!NILP (subprefix_stack
[j
]))
963 buf
.kind
= MENU_BAR_EVENT
;
964 buf
.frame_or_window
= frame
;
965 buf
.arg
= subprefix_stack
[j
];
966 kbd_buffer_store_event (&buf
);
971 buf
.kind
= MENU_BAR_EVENT
;
972 buf
.frame_or_window
= frame
;
974 kbd_buffer_store_event (&buf
);
977 buf
.kind
= MENU_BAR_EVENT
;
978 buf
.frame_or_window
= frame
;
980 kbd_buffer_store_event (&buf
);
984 i
+= MENU_ITEMS_ITEM_LENGTH
;
989 /* Allocate a widget_value, blocking input. */
992 xmalloc_widget_value ()
997 value
= malloc_widget_value ();
1003 /* This recursively calls free_widget_value on the tree of widgets.
1004 It must free all data that was malloc'ed for these widget_values.
1005 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1006 must be left alone. */
1009 free_menubar_widget_value_tree (wv
)
1014 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1016 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1018 free_menubar_widget_value_tree (wv
->contents
);
1019 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1023 free_menubar_widget_value_tree (wv
->next
);
1024 wv
->next
= (widget_value
*) 0xDEADBEEF;
1027 free_widget_value (wv
);
1031 /* Set up data in menu_items for a menu bar item
1032 whose event type is ITEM_KEY (with string ITEM_NAME)
1033 and whose contents come from the list of keymaps MAPS. */
1036 parse_single_submenu (item_key
, item_name
, maps
)
1037 Lisp_Object item_key
, item_name
, maps
;
1041 Lisp_Object
*mapvec
;
1043 int top_level_items
= 0;
1045 length
= Flength (maps
);
1046 len
= XINT (length
);
1048 /* Convert the list MAPS into a vector MAPVEC. */
1049 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1050 for (i
= 0; i
< len
; i
++)
1052 mapvec
[i
] = Fcar (maps
);
1056 /* Loop over the given keymaps, making a pane for each map.
1057 But don't make a pane that is empty--ignore that map instead. */
1058 for (i
= 0; i
< len
; i
++)
1060 if (!KEYMAPP (mapvec
[i
]))
1062 /* Here we have a command at top level in the menu bar
1063 as opposed to a submenu. */
1064 top_level_items
= 1;
1065 push_menu_pane (Qnil
, Qnil
);
1066 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1067 Qnil
, Qnil
, Qnil
, Qnil
);
1072 prompt
= Fkeymap_prompt (mapvec
[i
]);
1073 single_keymap_panes (mapvec
[i
],
1074 !NILP (prompt
) ? prompt
: item_name
,
1079 return top_level_items
;
1082 /* Create a tree of widget_value objects
1083 representing the panes and items
1084 in menu_items starting at index START, up to index END. */
1086 static widget_value
*
1087 digest_single_submenu (start
, end
, top_level_items
)
1088 int start
, end
, top_level_items
;
1090 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1092 int submenu_depth
= 0;
1093 widget_value
**submenu_stack
;
1097 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1098 wv
= xmalloc_widget_value ();
1102 wv
->button_type
= BUTTON_TYPE_NONE
;
1108 /* Loop over all panes and items made by the preceding call
1109 to parse_single_submenu and construct a tree of widget_value objects.
1110 Ignore the panes and items used by previous calls to
1111 digest_single_submenu, even though those are also in menu_items. */
1115 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1117 submenu_stack
[submenu_depth
++] = save_wv
;
1122 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1125 save_wv
= submenu_stack
[--submenu_depth
];
1128 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1129 && submenu_depth
!= 0)
1130 i
+= MENU_ITEMS_PANE_LENGTH
;
1131 /* Ignore a nil in the item list.
1132 It's meaningful only for dialog boxes. */
1133 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1135 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1137 /* Create a new pane. */
1138 Lisp_Object pane_name
, prefix
;
1143 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1144 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1146 #ifndef HAVE_MULTILINGUAL_MENU
1147 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1149 pane_name
= ENCODE_MENU_STRING (pane_name
);
1150 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1153 pane_string
= (NILP (pane_name
)
1154 ? "" : (char *) SDATA (pane_name
));
1155 /* If there is just one top-level pane, put all its items directly
1156 under the top-level menu. */
1157 if (menu_items_n_panes
== 1)
1160 /* If the pane has a meaningful name,
1161 make the pane a top-level menu item
1162 with its items as a submenu beneath it. */
1163 if (strcmp (pane_string
, ""))
1165 wv
= xmalloc_widget_value ();
1169 first_wv
->contents
= wv
;
1170 wv
->lname
= pane_name
;
1171 /* Set value to 1 so update_submenu_strings can handle '@' */
1172 wv
->value
= (char *)1;
1174 wv
->button_type
= BUTTON_TYPE_NONE
;
1182 i
+= MENU_ITEMS_PANE_LENGTH
;
1186 /* Create a new item within current pane. */
1187 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1190 /* All items should be contained in panes. */
1191 if (panes_seen
== 0)
1194 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1195 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1196 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1197 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1198 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1199 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1200 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1202 #ifndef HAVE_MULTILINGUAL_MENU
1203 if (STRING_MULTIBYTE (item_name
))
1205 item_name
= ENCODE_MENU_STRING (item_name
);
1206 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1209 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1211 descrip
= ENCODE_MENU_STRING (descrip
);
1212 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1214 #endif /* not HAVE_MULTILINGUAL_MENU */
1216 wv
= xmalloc_widget_value ();
1220 save_wv
->contents
= wv
;
1222 wv
->lname
= item_name
;
1223 if (!NILP (descrip
))
1226 /* The EMACS_INT cast avoids a warning. There's no problem
1227 as long as pointers have enough bits to hold small integers. */
1228 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1229 wv
->enabled
= !NILP (enable
);
1232 wv
->button_type
= BUTTON_TYPE_NONE
;
1233 else if (EQ (type
, QCradio
))
1234 wv
->button_type
= BUTTON_TYPE_RADIO
;
1235 else if (EQ (type
, QCtoggle
))
1236 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1240 wv
->selected
= !NILP (selected
);
1241 if (! STRINGP (help
))
1248 i
+= MENU_ITEMS_ITEM_LENGTH
;
1252 /* If we have just one "menu item"
1253 that was originally a button, return it by itself. */
1254 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1256 wv
= first_wv
->contents
;
1257 free_widget_value (first_wv
);
1264 /* Walk through the widget_value tree starting at FIRST_WV and update
1265 the char * pointers from the corresponding lisp values.
1266 We do this after building the whole tree, since GC may happen while the
1267 tree is constructed, and small strings are relocated. So we must wait
1268 until no GC can happen before storing pointers into lisp values. */
1270 update_submenu_strings (first_wv
)
1271 widget_value
*first_wv
;
1275 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1277 if (STRINGP (wv
->lname
))
1279 wv
->name
= SDATA (wv
->lname
);
1281 /* Ignore the @ that means "separate pane".
1282 This is a kludge, but this isn't worth more time. */
1283 if (wv
->value
== (char *)1)
1285 if (wv
->name
[0] == '@')
1291 if (STRINGP (wv
->lkey
))
1292 wv
->key
= SDATA (wv
->lkey
);
1295 update_submenu_strings (wv
->contents
);
1300 /* Set the contents of the menubar widgets of frame F.
1301 The argument FIRST_TIME is currently ignored;
1302 it is set the first time this is called, from initialize_frame_menubar. */
1305 set_frame_menubar (f
, first_time
, deep_p
)
1310 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1312 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1314 int *submenu_start
, *submenu_end
;
1315 int *submenu_top_level_items
, *submenu_n_panes
;
1317 XSETFRAME (Vmenu_updating_frame
, f
);
1319 /* This seems to be unnecessary for Carbon. */
1321 if (! menubar_widget
)
1323 else if (pending_menu_activation
&& !deep_p
)
1329 /* Make a widget-value tree representing the entire menu trees. */
1331 struct buffer
*prev
= current_buffer
;
1333 int specpdl_count
= SPECPDL_INDEX ();
1334 int previous_menu_items_used
= f
->menu_bar_items_used
;
1335 Lisp_Object
*previous_items
1336 = (Lisp_Object
*) alloca (previous_menu_items_used
1337 * sizeof (Lisp_Object
));
1339 /* If we are making a new widget, its contents are empty,
1340 do always reinitialize them. */
1341 if (! menubar_widget
)
1342 previous_menu_items_used
= 0;
1344 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1345 specbind (Qinhibit_quit
, Qt
);
1346 /* Don't let the debugger step into this code
1347 because it is not reentrant. */
1348 specbind (Qdebug_on_next_call
, Qnil
);
1350 record_unwind_save_match_data ();
1351 if (NILP (Voverriding_local_map_menu_flag
))
1353 specbind (Qoverriding_terminal_local_map
, Qnil
);
1354 specbind (Qoverriding_local_map
, Qnil
);
1357 set_buffer_internal_1 (XBUFFER (buffer
));
1359 /* Run the Lucid hook. */
1360 safe_run_hooks (Qactivate_menubar_hook
);
1362 /* If it has changed current-menubar from previous value,
1363 really recompute the menubar from the value. */
1364 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1365 call0 (Qrecompute_lucid_menubar
);
1366 safe_run_hooks (Qmenu_bar_update_hook
);
1367 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1369 items
= FRAME_MENU_BAR_ITEMS (f
);
1371 /* Save the frame's previous menu bar contents data. */
1372 if (previous_menu_items_used
)
1373 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1374 previous_menu_items_used
* sizeof (Lisp_Object
));
1376 /* Fill in menu_items with the current menu bar contents.
1377 This can evaluate Lisp code. */
1380 menu_items
= f
->menu_bar_vector
;
1381 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1382 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1383 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1384 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1385 submenu_top_level_items
1386 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1388 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1390 Lisp_Object key
, string
, maps
;
1394 key
= XVECTOR (items
)->contents
[i
];
1395 string
= XVECTOR (items
)->contents
[i
+ 1];
1396 maps
= XVECTOR (items
)->contents
[i
+ 2];
1400 submenu_start
[i
] = menu_items_used
;
1402 menu_items_n_panes
= 0;
1403 submenu_top_level_items
[i
]
1404 = parse_single_submenu (key
, string
, maps
);
1405 submenu_n_panes
[i
] = menu_items_n_panes
;
1407 submenu_end
[i
] = menu_items_used
;
1410 finish_menu_items ();
1412 /* Convert menu_items into widget_value trees
1413 to display the menu. This cannot evaluate Lisp code. */
1415 wv
= xmalloc_widget_value ();
1416 wv
->name
= "menubar";
1419 wv
->button_type
= BUTTON_TYPE_NONE
;
1423 for (i
= 0; i
< last_i
; i
+= 4)
1425 menu_items_n_panes
= submenu_n_panes
[i
];
1426 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1427 submenu_top_level_items
[i
]);
1431 first_wv
->contents
= wv
;
1432 /* Don't set wv->name here; GC during the loop might relocate it. */
1434 wv
->button_type
= BUTTON_TYPE_NONE
;
1438 set_buffer_internal_1 (prev
);
1440 /* If there has been no change in the Lisp-level contents
1441 of the menu bar, skip redisplaying it. Just exit. */
1443 /* Compare the new menu items with the ones computed last time. */
1444 for (i
= 0; i
< previous_menu_items_used
; i
++)
1445 if (menu_items_used
== i
1446 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1448 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1450 /* The menu items have not changed. Don't bother updating
1451 the menus in any form, since it would be a no-op. */
1452 free_menubar_widget_value_tree (first_wv
);
1453 discard_menu_items ();
1454 unbind_to (specpdl_count
, Qnil
);
1458 /* The menu items are different, so store them in the frame. */
1459 f
->menu_bar_vector
= menu_items
;
1460 f
->menu_bar_items_used
= menu_items_used
;
1462 /* This calls restore_menu_items to restore menu_items, etc.,
1463 as they were outside. */
1464 unbind_to (specpdl_count
, Qnil
);
1466 /* Now GC cannot happen during the lifetime of the widget_value,
1467 so it's safe to store data from a Lisp_String. */
1468 wv
= first_wv
->contents
;
1469 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1472 string
= XVECTOR (items
)->contents
[i
+ 1];
1475 wv
->name
= (char *) SDATA (string
);
1476 update_submenu_strings (wv
->contents
);
1483 /* Make a widget-value tree containing
1484 just the top level menu bar strings. */
1486 wv
= xmalloc_widget_value ();
1487 wv
->name
= "menubar";
1490 wv
->button_type
= BUTTON_TYPE_NONE
;
1494 items
= FRAME_MENU_BAR_ITEMS (f
);
1495 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1499 string
= XVECTOR (items
)->contents
[i
+ 1];
1503 wv
= xmalloc_widget_value ();
1504 wv
->name
= (char *) SDATA (string
);
1507 wv
->button_type
= BUTTON_TYPE_NONE
;
1509 /* This prevents lwlib from assuming this
1510 menu item is really supposed to be empty. */
1511 /* The EMACS_INT cast avoids a warning.
1512 This value just has to be different from small integers. */
1513 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1518 first_wv
->contents
= wv
;
1522 /* Forget what we thought we knew about what is in the
1523 detailed contents of the menu bar menus.
1524 Changing the top level always destroys the contents. */
1525 f
->menu_bar_items_used
= 0;
1528 /* Create or update the menu bar widget. */
1532 /* Non-null value to indicate menubar has already been "created". */
1533 f
->output_data
.mac
->menubar_widget
= 1;
1535 mac_fill_menubar (first_wv
->contents
, deep_p
);
1537 free_menubar_widget_value_tree (first_wv
);
1542 /* Get rid of the menu bar of frame F, and free its storage.
1543 This is used when deleting a frame, and when turning off the menu bar. */
1546 free_frame_menubar (f
)
1549 f
->output_data
.mac
->menubar_widget
= 0;
1553 /* The item selected in the popup menu. */
1554 int menu_item_selection
;
1556 /* Mac_menu_show actually displays a menu using the panes and items in
1557 menu_items and returns the value selected from it; we assume input
1558 is blocked by the caller. */
1560 /* F is the frame the menu is for.
1561 X and Y are the frame-relative specified position,
1562 relative to the inside upper left corner of the frame F.
1563 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1564 KEYMAPS is 1 if this menu was specified with keymaps;
1565 in that case, we return a list containing the chosen item's value
1566 and perhaps also the pane's prefix.
1567 TITLE is the specified menu title.
1568 ERROR is a place to store an error message string in case of failure.
1569 (We return nil on failure, but the value doesn't actually matter.) */
1572 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1582 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1583 widget_value
**submenu_stack
1584 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1585 Lisp_Object
*subprefix_stack
1586 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1587 int submenu_depth
= 0;
1593 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1595 *error
= "Empty menu";
1599 /* Create a tree of widget_value objects
1600 representing the panes and their items. */
1601 wv
= xmalloc_widget_value ();
1605 wv
->button_type
= BUTTON_TYPE_NONE
;
1610 /* Loop over all panes and items, filling in the tree. */
1612 while (i
< menu_items_used
)
1614 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1616 submenu_stack
[submenu_depth
++] = save_wv
;
1622 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1625 save_wv
= submenu_stack
[--submenu_depth
];
1629 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1630 && submenu_depth
!= 0)
1631 i
+= MENU_ITEMS_PANE_LENGTH
;
1632 /* Ignore a nil in the item list.
1633 It's meaningful only for dialog boxes. */
1634 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1636 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1638 /* Create a new pane. */
1639 Lisp_Object pane_name
, prefix
;
1642 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1643 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1645 #ifndef HAVE_MULTILINGUAL_MENU
1646 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1648 pane_name
= ENCODE_MENU_STRING (pane_name
);
1649 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1652 pane_string
= (NILP (pane_name
)
1653 ? "" : (char *) SDATA (pane_name
));
1654 /* If there is just one top-level pane, put all its items directly
1655 under the top-level menu. */
1656 if (menu_items_n_panes
== 1)
1659 /* If the pane has a meaningful name,
1660 make the pane a top-level menu item
1661 with its items as a submenu beneath it. */
1662 if (!keymaps
&& strcmp (pane_string
, ""))
1664 wv
= xmalloc_widget_value ();
1668 first_wv
->contents
= wv
;
1669 wv
->name
= pane_string
;
1670 if (keymaps
&& !NILP (prefix
))
1674 wv
->button_type
= BUTTON_TYPE_NONE
;
1679 else if (first_pane
)
1685 i
+= MENU_ITEMS_PANE_LENGTH
;
1689 /* Create a new item within current pane. */
1690 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1691 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1692 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1693 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1694 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1695 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1696 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1697 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1699 #ifndef HAVE_MULTILINGUAL_MENU
1700 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1702 item_name
= ENCODE_MENU_STRING (item_name
);
1703 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1706 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1708 descrip
= ENCODE_MENU_STRING (descrip
);
1709 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1711 #endif /* not HAVE_MULTILINGUAL_MENU */
1713 wv
= xmalloc_widget_value ();
1717 save_wv
->contents
= wv
;
1718 wv
->name
= (char *) SDATA (item_name
);
1719 if (!NILP (descrip
))
1720 wv
->key
= (char *) SDATA (descrip
);
1722 /* Use the contents index as call_data, since we are
1723 restricted to 16-bits. */
1724 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1725 wv
->enabled
= !NILP (enable
);
1728 wv
->button_type
= BUTTON_TYPE_NONE
;
1729 else if (EQ (type
, QCtoggle
))
1730 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1731 else if (EQ (type
, QCradio
))
1732 wv
->button_type
= BUTTON_TYPE_RADIO
;
1736 wv
->selected
= !NILP (selected
);
1738 if (! STRINGP (help
))
1745 i
+= MENU_ITEMS_ITEM_LENGTH
;
1749 /* Deal with the title, if it is non-nil. */
1752 widget_value
*wv_title
= xmalloc_widget_value ();
1753 widget_value
*wv_sep
= xmalloc_widget_value ();
1755 /* Maybe replace this separator with a bitmap or owner-draw item
1756 so that it looks better. Having two separators looks odd. */
1757 wv_sep
->name
= "--";
1758 wv_sep
->next
= first_wv
->contents
;
1759 wv_sep
->help
= Qnil
;
1761 #ifndef HAVE_MULTILINGUAL_MENU
1762 if (STRING_MULTIBYTE (title
))
1763 title
= ENCODE_MENU_STRING (title
);
1766 wv_title
->name
= (char *) SDATA (title
);
1767 wv_title
->enabled
= FALSE
;
1768 wv_title
->title
= TRUE
;
1769 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1770 wv_title
->help
= Qnil
;
1771 wv_title
->next
= wv_sep
;
1772 first_wv
->contents
= wv_title
;
1775 /* No selection has been chosen yet. */
1776 menu_item_selection
= 0;
1778 /* Actually create and show the menu until popped down. */
1779 create_and_show_popup_menu (f
, first_wv
, x
, y
, for_click
);
1781 /* Free the widget_value objects we used to specify the contents. */
1782 free_menubar_widget_value_tree (first_wv
);
1784 /* Find the selected item, and its pane, to return
1785 the proper value. */
1786 if (menu_item_selection
!= 0)
1788 Lisp_Object prefix
, entry
;
1790 prefix
= entry
= Qnil
;
1792 while (i
< menu_items_used
)
1794 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1796 subprefix_stack
[submenu_depth
++] = prefix
;
1800 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1802 prefix
= subprefix_stack
[--submenu_depth
];
1805 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1808 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1809 i
+= MENU_ITEMS_PANE_LENGTH
;
1811 /* Ignore a nil in the item list.
1812 It's meaningful only for dialog boxes. */
1813 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1818 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1819 if (menu_item_selection
== i
)
1825 entry
= Fcons (entry
, Qnil
);
1827 entry
= Fcons (prefix
, entry
);
1828 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1829 if (!NILP (subprefix_stack
[j
]))
1830 entry
= Fcons (subprefix_stack
[j
], entry
);
1834 i
+= MENU_ITEMS_ITEM_LENGTH
;
1838 else if (!for_click
)
1839 /* Make "Cancel" equivalent to C-g. */
1840 Fsignal (Qquit
, Qnil
);
1847 /* Construct native Mac OS dialog based on widget_value tree. */
1849 static char * button_names
[] = {
1850 "button1", "button2", "button3", "button4", "button5",
1851 "button6", "button7", "button8", "button9", "button10" };
1854 mac_dialog_show (f
, keymaps
, title
, header
, error_name
)
1857 Lisp_Object title
, header
;
1860 int i
, nb_buttons
=0;
1861 char dialog_name
[6];
1863 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1865 /* Number of elements seen so far, before boundary. */
1867 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1868 int boundary_seen
= 0;
1872 if (menu_items_n_panes
> 1)
1874 *error_name
= "Multiple panes in dialog box";
1878 /* Create a tree of widget_value objects
1879 representing the text label and buttons. */
1881 Lisp_Object pane_name
, prefix
;
1883 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1884 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1885 pane_string
= (NILP (pane_name
)
1886 ? "" : (char *) SDATA (pane_name
));
1887 prev_wv
= xmalloc_widget_value ();
1888 prev_wv
->value
= pane_string
;
1889 if (keymaps
&& !NILP (prefix
))
1891 prev_wv
->enabled
= 1;
1892 prev_wv
->name
= "message";
1893 prev_wv
->help
= Qnil
;
1896 /* Loop over all panes and items, filling in the tree. */
1897 i
= MENU_ITEMS_PANE_LENGTH
;
1898 while (i
< menu_items_used
)
1901 /* Create a new item within current pane. */
1902 Lisp_Object item_name
, enable
, descrip
;
1903 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1904 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1906 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1908 if (NILP (item_name
))
1910 free_menubar_widget_value_tree (first_wv
);
1911 *error_name
= "Submenu in dialog items";
1914 if (EQ (item_name
, Qquote
))
1916 /* This is the boundary between left-side elts
1917 and right-side elts. Stop incrementing right_count. */
1922 if (nb_buttons
>= 9)
1924 free_menubar_widget_value_tree (first_wv
);
1925 *error_name
= "Too many dialog items";
1929 wv
= xmalloc_widget_value ();
1931 wv
->name
= (char *) button_names
[nb_buttons
];
1932 if (!NILP (descrip
))
1933 wv
->key
= (char *) SDATA (descrip
);
1934 wv
->value
= (char *) SDATA (item_name
);
1935 wv
->call_data
= (void *) i
;
1936 /* menu item is identified by its index in menu_items table */
1937 wv
->enabled
= !NILP (enable
);
1941 if (! boundary_seen
)
1945 i
+= MENU_ITEMS_ITEM_LENGTH
;
1948 /* If the boundary was not specified,
1949 by default put half on the left and half on the right. */
1950 if (! boundary_seen
)
1951 left_count
= nb_buttons
- nb_buttons
/ 2;
1953 wv
= xmalloc_widget_value ();
1954 wv
->name
= dialog_name
;
1957 /* Frame title: 'Q' = Question, 'I' = Information.
1958 Can also have 'E' = Error if, one day, we want
1959 a popup for errors. */
1961 dialog_name
[0] = 'Q';
1963 dialog_name
[0] = 'I';
1965 /* Dialog boxes use a really stupid name encoding
1966 which specifies how many buttons to use
1967 and how many buttons are on the right. */
1968 dialog_name
[1] = '0' + nb_buttons
;
1969 dialog_name
[2] = 'B';
1970 dialog_name
[3] = 'R';
1971 /* Number of buttons to put on the right. */
1972 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1974 wv
->contents
= first_wv
;
1978 /* No selection has been chosen yet. */
1979 menu_item_selection
= 0;
1981 /* Force a redisplay before showing the dialog. If a frame is created
1982 just before showing the dialog, its contents may not have been fully
1986 /* Actually create the dialog. */
1987 #if TARGET_API_MAC_CARBON
1988 create_and_show_dialog (f
, first_wv
);
1990 menu_item_selection
= mac_dialog (first_wv
);
1993 /* Free the widget_value objects we used to specify the contents. */
1994 free_menubar_widget_value_tree (first_wv
);
1996 /* Find the selected item, and its pane, to return
1997 the proper value. */
1998 if (menu_item_selection
!= 0)
2004 while (i
< menu_items_used
)
2008 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2011 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2012 i
+= MENU_ITEMS_PANE_LENGTH
;
2014 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
2016 /* This is the boundary between left-side elts and
2023 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2024 if (menu_item_selection
== i
)
2028 entry
= Fcons (entry
, Qnil
);
2030 entry
= Fcons (prefix
, entry
);
2034 i
+= MENU_ITEMS_ITEM_LENGTH
;
2039 /* Make "Cancel" equivalent to C-g. */
2040 Fsignal (Qquit
, Qnil
);
2044 #endif /* HAVE_DIALOGS */
2047 /* Is this item a separator? */
2049 name_is_separator (name
)
2052 const char *start
= name
;
2054 /* Check if name string consists of only dashes ('-'). */
2055 while (*name
== '-') name
++;
2056 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2057 or "--deep-shadow". We don't implement them yet, se we just treat
2058 them like normal separators. */
2059 return (*name
== '\0' || start
+ 2 == name
);
2061 #endif /* HAVE_MENUS */
2063 /* Detect if a menu is currently active. */
2068 return popup_activated_flag
;
2071 /* The following is used by delayed window autoselection. */
2073 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2074 doc
: /* Return t if a menu or popup dialog is active. */)
2077 #if TARGET_API_MAC_CARBON
2078 return (popup_activated ()) ? Qt
: Qnil
;
2080 /* Always return Qnil since menu selection functions do not return
2081 until a selection has been made or cancelled. */
2089 staticpro (&menu_items
);
2092 Qdebug_on_next_call
= intern ("debug-on-next-call");
2093 staticpro (&Qdebug_on_next_call
);
2095 defsubr (&Sx_popup_menu
);
2096 defsubr (&Smenu_or_popup_active_p
);
2098 defsubr (&Sx_popup_dialog
);
2102 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2103 (do not change this comment) */