1 /* Menu support for GNU Emacs on the for Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Contributed by Andrew Choi (akochoi@mac.com). */
27 #include "termhooks.h"
32 #include "blockinput.h"
37 #if !TARGET_API_MAC_CARBON
40 #include <QuickDraw.h>
41 #include <ToolUtils.h>
46 #if defined (__MRC__) || (__MSL__ >= 0x6000)
47 #include <ControlDefinitions.h>
49 #endif /* not TARGET_API_MAC_CARBON */
51 /* This may include sys/types.h, and that somehow loses
52 if this is not done before the other system files. */
55 /* Load sys/types.h if not already loaded.
56 In some systems loading it twice is suicidal. */
58 #include <sys/types.h>
61 #include "dispextern.h"
63 #define POPUP_SUBMENU_ID 235
64 #define MIN_POPUP_SUBMENU_ID 512
65 #define MIN_MENU_ID 256
66 #define MIN_SUBMENU_ID 1
68 #define DIALOG_WINDOW_RESOURCE 130
70 #define HAVE_DIALOGS 1
72 #undef HAVE_MULTILINGUAL_MENU
73 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
75 /******************************************************************/
76 /* Definitions copied from lwlib.h */
78 typedef void * XtPointer
;
87 /* This structure is based on the one in ../lwlib/lwlib.h, modified
89 typedef struct _widget_value
94 /* value (meaning depend on widget type) */
96 /* keyboard equivalent. no implications for XtTranslations */
99 /* Help string or nil if none.
100 GC finds this string through the frame's menu_bar_vector
101 or through menu_items. */
103 /* true if enabled */
105 /* true if selected */
107 /* The type of a button. */
108 enum button_type button_type
;
109 /* true if menu title */
112 /* true if was edited (maintained by get_value) */
114 /* true if has changed (maintained by lw library) */
116 /* true if this widget itself has changed,
117 but not counting the other widgets found in the `next' field. */
118 change_type this_one_change
;
120 /* Contents of the sub-widgets, also selected slot for checkbox */
121 struct _widget_value
* contents
;
122 /* data passed to callback */
124 /* next one in the list */
125 struct _widget_value
* next
;
127 /* slot for the toolkit dependent part. Always initialize to NULL. */
129 /* tell us if we should free the toolkit data slot when freeing the
130 widget_value itself. */
131 Boolean free_toolkit_data
;
133 /* we resource the widget_value structures; this points to the next
134 one on the free list if this one has been deallocated.
136 struct _widget_value
*free_list
;
140 /* Assumed by other routines to zero area returned. */
141 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
142 0, (sizeof (widget_value)))
143 #define free_widget_value(wv) xfree (wv)
145 /******************************************************************/
152 Lisp_Object Vmenu_updating_frame
;
154 Lisp_Object Qdebug_on_next_call
;
156 extern Lisp_Object Qmenu_bar
;
158 extern Lisp_Object QCtoggle
, QCradio
;
160 extern Lisp_Object Voverriding_local_map
;
161 extern Lisp_Object Voverriding_local_map_menu_flag
;
163 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
165 extern Lisp_Object Qmenu_bar_update_hook
;
167 #if TARGET_API_MAC_CARBON
168 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
170 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
173 void set_frame_menubar ();
175 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
176 Lisp_Object
, Lisp_Object
, Lisp_Object
,
177 Lisp_Object
, Lisp_Object
));
179 static Lisp_Object
mac_dialog_show ();
181 static Lisp_Object
mac_menu_show ();
183 static void keymap_panes ();
184 static void single_keymap_panes ();
185 static void single_menu_item ();
186 static void list_of_panes ();
187 static void list_of_items ();
189 static void fill_submenu (MenuHandle
, widget_value
*);
190 static void fill_menubar (widget_value
*);
193 /* This holds a Lisp vector that holds the results of decoding
194 the keymaps or alist-of-alists that specify a menu.
196 It describes the panes and items within the panes.
198 Each pane is described by 3 elements in the vector:
199 t, the pane name, the pane's prefix key.
200 Then follow the pane's items, with 5 elements per item:
201 the item string, the enable flag, the item's value,
202 the definition, and the equivalent keyboard key's description string.
204 In some cases, multiple levels of menus may be described.
205 A single vector slot containing nil indicates the start of a submenu.
206 A single vector slot containing lambda indicates the end of a submenu.
207 The submenu follows a menu item which is the way to reach the submenu.
209 A single vector slot containing quote indicates that the
210 following items should appear on the right of a dialog box.
212 Using a Lisp vector to hold this information while we decode it
213 takes care of protecting all the data from GC. */
215 #define MENU_ITEMS_PANE_NAME 1
216 #define MENU_ITEMS_PANE_PREFIX 2
217 #define MENU_ITEMS_PANE_LENGTH 3
221 MENU_ITEMS_ITEM_NAME
= 0,
222 MENU_ITEMS_ITEM_ENABLE
,
223 MENU_ITEMS_ITEM_VALUE
,
224 MENU_ITEMS_ITEM_EQUIV_KEY
,
225 MENU_ITEMS_ITEM_DEFINITION
,
226 MENU_ITEMS_ITEM_TYPE
,
227 MENU_ITEMS_ITEM_SELECTED
,
228 MENU_ITEMS_ITEM_HELP
,
229 MENU_ITEMS_ITEM_LENGTH
232 static Lisp_Object menu_items
;
234 /* Number of slots currently allocated in menu_items. */
235 static int menu_items_allocated
;
237 /* This is the index in menu_items of the first empty slot. */
238 static int menu_items_used
;
240 /* The number of panes currently recorded in menu_items,
241 excluding those within submenus. */
242 static int menu_items_n_panes
;
244 /* Current depth within submenus. */
245 static int menu_items_submenu_depth
;
247 /* Flag which when set indicates a dialog or menu has been posted by
248 Xt on behalf of one of the widget sets. */
249 static int popup_activated_flag
;
251 /* Index of the next submenu */
252 static int submenu_id
;
254 static int next_menubar_widget_id
;
256 /* This is set nonzero after the user activates the menu bar, and set
257 to zero again after the menu bars are redisplayed by prepare_menu_bar.
258 While it is nonzero, all calls to set_frame_menubar go deep.
260 I don't understand why this is needed, but it does seem to be
261 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
263 int pending_menu_activation
;
265 /* Initialize the menu_items structure if we haven't already done so.
266 Also mark it as currently empty. */
271 if (NILP (menu_items
))
273 menu_items_allocated
= 60;
274 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
278 menu_items_n_panes
= 0;
279 menu_items_submenu_depth
= 0;
282 /* Call at the end of generating the data in menu_items.
283 This fills in the number of items in the last pane. */
290 /* Call when finished using the data for the current menu
294 discard_menu_items ()
296 /* Free the structure if it is especially large.
297 Otherwise, hold on to it, to save time. */
298 if (menu_items_allocated
> 200)
301 menu_items_allocated
= 0;
305 /* Make the menu_items vector twice as large. */
311 int old_size
= menu_items_allocated
;
314 menu_items_allocated
*= 2;
315 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
316 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
317 old_size
* sizeof (Lisp_Object
));
320 /* Begin a submenu. */
323 push_submenu_start ()
325 if (menu_items_used
+ 1 > menu_items_allocated
)
328 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
329 menu_items_submenu_depth
++;
337 if (menu_items_used
+ 1 > menu_items_allocated
)
340 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
341 menu_items_submenu_depth
--;
344 /* Indicate boundary between left and right. */
347 push_left_right_boundary ()
349 if (menu_items_used
+ 1 > menu_items_allocated
)
352 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
355 /* Start a new menu pane in menu_items.
356 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
359 push_menu_pane (name
, prefix_vec
)
360 Lisp_Object name
, prefix_vec
;
362 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
365 if (menu_items_submenu_depth
== 0)
366 menu_items_n_panes
++;
367 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
368 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
369 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
372 /* Push one menu item into the current pane. NAME is the string to
373 display. ENABLE if non-nil means this item can be selected. KEY
374 is the key generated by choosing this item, or nil if this item
375 doesn't really have a definition. DEF is the definition of this
376 item. EQUIV is the textual description of the keyboard equivalent
377 for this item (or nil if none). TYPE is the type of this menu
378 item, one of nil, `toggle' or `radio'. */
381 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
382 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
384 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
387 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
388 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
389 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
390 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
391 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
392 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
393 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
394 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
397 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
398 and generate menu panes for them in menu_items.
399 If NOTREAL is nonzero,
400 don't bother really computing whether an item is enabled. */
403 keymap_panes (keymaps
, nmaps
, notreal
)
404 Lisp_Object
*keymaps
;
412 /* Loop over the given keymaps, making a pane for each map.
413 But don't make a pane that is empty--ignore that map instead.
414 P is the number of panes we have made so far. */
415 for (mapno
= 0; mapno
< nmaps
; mapno
++)
416 single_keymap_panes (keymaps
[mapno
],
417 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
419 finish_menu_items ();
422 /* This is a recursive subroutine of keymap_panes.
423 It handles one keymap, KEYMAP.
424 The other arguments are passed along
425 or point to local variables of the previous function.
426 If NOTREAL is nonzero, only check for equivalent key bindings, don't
427 evaluate expressions in menu items and don't make any menu.
429 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
432 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
434 Lisp_Object pane_name
;
439 Lisp_Object pending_maps
= Qnil
;
440 Lisp_Object tail
, item
;
441 struct gcpro gcpro1
, gcpro2
;
446 push_menu_pane (pane_name
, prefix
);
448 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
450 GCPRO2 (keymap
, pending_maps
);
451 /* Look at each key binding, and if it is a menu item add it
455 single_menu_item (XCAR (item
), XCDR (item
),
456 &pending_maps
, notreal
, maxdepth
);
457 else if (VECTORP (item
))
459 /* Loop over the char values represented in the vector. */
460 int len
= XVECTOR (item
)->size
;
462 for (c
= 0; c
< len
; c
++)
464 Lisp_Object character
;
465 XSETFASTINT (character
, c
);
466 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
467 &pending_maps
, notreal
, maxdepth
);
473 /* Process now any submenus which want to be panes at this level. */
474 while (!NILP (pending_maps
))
476 Lisp_Object elt
, eltcdr
, string
;
477 elt
= Fcar (pending_maps
);
479 string
= XCAR (eltcdr
);
480 /* We no longer discard the @ from the beginning of the string here.
481 Instead, we do this in mac_menu_show. */
482 single_keymap_panes (Fcar (elt
), string
,
483 XCDR (eltcdr
), notreal
, maxdepth
- 1);
484 pending_maps
= Fcdr (pending_maps
);
488 /* This is a subroutine of single_keymap_panes that handles one
490 KEY is a key in a keymap and ITEM is its binding.
491 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
493 If NOTREAL is nonzero, only check for equivalent key bindings, don't
494 evaluate expressions in menu items and don't make any menu.
495 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
498 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
499 Lisp_Object key
, item
;
500 Lisp_Object
*pending_maps_ptr
;
501 int maxdepth
, notreal
;
503 Lisp_Object map
, item_string
, enabled
;
504 struct gcpro gcpro1
, gcpro2
;
507 /* Parse the menu item and leave the result in item_properties. */
509 res
= parse_menu_item (item
, notreal
, 0);
512 return; /* Not a menu item. */
514 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
518 /* We don't want to make a menu, just traverse the keymaps to
519 precompute equivalent key bindings. */
521 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
525 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
526 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
528 if (!NILP (map
) && SREF (item_string
, 0) == '@')
531 /* An enabled separate pane. Remember this to handle it later. */
532 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
537 push_menu_item (item_string
, enabled
, key
,
538 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
539 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
540 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
541 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
542 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
544 /* Display a submenu using the toolkit. */
545 if (! (NILP (map
) || NILP (enabled
)))
547 push_submenu_start ();
548 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
553 /* Push all the panes and items of a menu described by the
554 alist-of-alists MENU.
555 This handles old-fashioned calls to x-popup-menu. */
565 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
567 Lisp_Object elt
, pane_name
, pane_data
;
569 pane_name
= Fcar (elt
);
570 CHECK_STRING (pane_name
);
571 push_menu_pane (pane_name
, Qnil
);
572 pane_data
= Fcdr (elt
);
573 CHECK_CONS (pane_data
);
574 list_of_items (pane_data
);
577 finish_menu_items ();
580 /* Push the items in a single pane defined by the alist PANE. */
586 Lisp_Object tail
, item
, item1
;
588 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
592 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
593 else if (NILP (item
))
594 push_left_right_boundary ();
599 CHECK_STRING (item1
);
600 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
605 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
606 doc
: /* Pop up a deck-of-cards menu and return user's selection.
607 POSITION is a position specification. This is either a mouse button
608 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
609 are positions in pixels from the top left corner of WINDOW's frame
610 \(WINDOW may be a frame object instead of a window). This controls the
611 position of the center of the first line in the first pane of the
612 menu, not the top left of the menu as a whole. If POSITION is t, it
613 means to use the current mouse position.
615 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
616 The menu items come from key bindings that have a menu string as well as
617 a definition; actually, the \"definition\" in such a key binding looks like
618 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
619 the keymap as a top-level element.
621 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
622 Otherwise, REAL-DEFINITION should be a valid key binding definition.
624 You can also use a list of keymaps as MENU. Then each keymap makes a
625 separate pane. When MENU is a keymap or a list of keymaps, the return
626 value is a list of events.
628 Alternatively, you can specify a menu of multiple panes with a list of
629 the form (TITLE PANE1 PANE2...), where each pane is a list of
630 form (TITLE ITEM1 ITEM2...).
631 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
632 appear as an item--that makes a nonselectable line in the menu.
633 With this form of menu, the return value is VALUE from the chosen item.
635 If POSITION is nil, don't display the menu at all, just precalculate the
636 cached information about equivalent key sequences. */)
638 Lisp_Object position
, menu
;
640 Lisp_Object keymap
, tem
;
641 int xpos
= 0, ypos
= 0;
644 Lisp_Object selection
;
646 Lisp_Object x
, y
, window
;
652 if (! NILP (position
))
656 /* Decode the first argument: find the window and the coordinates. */
657 if (EQ (position
, Qt
)
658 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
659 || EQ (XCAR (position
), Qtool_bar
))))
661 /* Use the mouse's current position. */
662 FRAME_PTR new_f
= SELECTED_FRAME ();
663 Lisp_Object bar_window
;
664 enum scroll_bar_part part
;
667 if (mouse_position_hook
)
668 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
669 &part
, &x
, &y
, &time
);
671 XSETFRAME (window
, new_f
);
674 window
= selected_window
;
681 tem
= Fcar (position
);
684 window
= Fcar (Fcdr (position
));
686 y
= Fcar (Fcdr (tem
));
691 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
692 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
693 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
702 /* Decode where to put the menu. */
710 else if (WINDOWP (window
))
712 CHECK_LIVE_WINDOW (window
);
713 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
715 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
716 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
719 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
720 but I don't want to make one now. */
721 CHECK_WINDOW (window
);
726 XSETFRAME (Vmenu_updating_frame
, f
);
728 Vmenu_updating_frame
= Qnil
;
729 #endif /* HAVE_MENUS */
734 /* Decode the menu items from what was specified. */
736 keymap
= get_keymap (menu
, 0, 0);
739 /* We were given a keymap. Extract menu info from the keymap. */
742 /* Extract the detailed info to make one pane. */
743 keymap_panes (&menu
, 1, NILP (position
));
745 /* Search for a string appearing directly as an element of the keymap.
746 That string is the title of the menu. */
747 prompt
= Fkeymap_prompt (keymap
);
748 if (NILP (title
) && !NILP (prompt
))
751 /* Make that be the pane title of the first pane. */
752 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
753 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
757 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
759 /* We were given a list of keymaps. */
760 int nmaps
= XFASTINT (Flength (menu
));
762 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
767 /* The first keymap that has a prompt string
768 supplies the menu title. */
769 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
773 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
775 prompt
= Fkeymap_prompt (keymap
);
776 if (NILP (title
) && !NILP (prompt
))
780 /* Extract the detailed info to make one pane. */
781 keymap_panes (maps
, nmaps
, NILP (position
));
783 /* Make the title be the pane title of the first pane. */
784 if (!NILP (title
) && menu_items_n_panes
>= 0)
785 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
791 /* We were given an old-fashioned menu. */
793 CHECK_STRING (title
);
795 list_of_panes (Fcdr (menu
));
802 discard_menu_items ();
808 /* Display them in a menu. */
811 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
812 keymaps
, title
, &error_name
);
815 discard_menu_items ();
818 #endif /* HAVE_MENUS */
820 if (error_name
) error (error_name
);
826 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
827 doc
: /* Pop up a dialog box and return user's selection.
828 POSITION specifies which frame to use.
829 This is normally a mouse button event or a window or frame.
830 If POSITION is t, it means to use the frame the mouse is on.
831 The dialog box appears in the middle of the specified frame.
833 CONTENTS specifies the alternatives to display in the dialog box.
834 It is a list of the form (TITLE ITEM1 ITEM2...).
835 Each ITEM is a cons cell (STRING . VALUE).
836 The return value is VALUE from the chosen item.
838 An ITEM may also be just a string--that makes a nonselectable item.
839 An ITEM may also be nil--that means to put all preceding items
840 on the left of the dialog box and all following items on the right.
841 \(By default, approximately half appear on each side.)
843 If HEADER is non-nil, the frame title for the box is "Information",
844 otherwise it is "Question". */)
845 (position
, contents
, header
)
846 Lisp_Object position
, contents
, header
;
853 /* Decode the first argument: find the window or frame to use. */
854 if (EQ (position
, Qt
)
855 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
856 || EQ (XCAR (position
), Qtool_bar
))))
858 #if 0 /* Using the frame the mouse is on may not be right. */
859 /* Use the mouse's current position. */
860 FRAME_PTR new_f
= SELECTED_FRAME ();
861 Lisp_Object bar_window
;
862 enum scroll_bar_part part
;
866 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
869 XSETFRAME (window
, new_f
);
871 window
= selected_window
;
873 window
= selected_window
;
875 else if (CONSP (position
))
878 tem
= Fcar (position
);
880 window
= Fcar (Fcdr (position
));
883 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
884 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
887 else if (WINDOWP (position
) || FRAMEP (position
))
892 /* Decode where to put the menu. */
896 else if (WINDOWP (window
))
898 CHECK_LIVE_WINDOW (window
);
899 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
902 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
903 but I don't want to make one now. */
904 CHECK_WINDOW (window
);
907 /* Display a menu with these alternatives
908 in the middle of frame F. */
910 Lisp_Object x
, y
, frame
, newpos
;
911 XSETFRAME (frame
, f
);
912 XSETINT (x
, x_pixel_width (f
) / 2);
913 XSETINT (y
, x_pixel_height (f
) / 2);
914 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
916 return Fx_popup_menu (newpos
,
917 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
919 #else /* HAVE_DIALOGS */
923 Lisp_Object selection
;
925 /* Decode the dialog items from what was specified. */
926 title
= Fcar (contents
);
927 CHECK_STRING (title
);
929 list_of_panes (Fcons (contents
, Qnil
));
931 /* Display them in a dialog box. */
933 selection
= mac_dialog_show (f
, 0, title
, header
, &error_name
);
936 discard_menu_items ();
938 if (error_name
) error (error_name
);
941 #endif /* HAVE_DIALOGS */
944 /* Activate the menu bar of frame F.
945 This is called from keyboard.c when it gets the
946 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
948 To activate the menu bar, we signal to the input thread that it can
949 return from the WM_INITMENU message, allowing the normal Windows
950 processing of the menus.
952 But first we recompute the menu bar contents (the whole tree).
954 This way we can safely execute Lisp code. */
957 x_activate_menubar (f
)
961 extern Point saved_menu_event_location
;
963 set_frame_menubar (f
, 0, 1);
966 menu_choice
= MenuSelect (saved_menu_event_location
);
967 do_menu_choice (menu_choice
);
972 /* This callback is called from the menu bar pulldown menu
973 when the user makes a selection.
974 Figure out what the user chose
975 and put the appropriate events into the keyboard buffer. */
978 menubar_selection_callback (FRAME_PTR f
, int client_data
)
980 Lisp_Object prefix
, entry
;
982 Lisp_Object
*subprefix_stack
;
983 int submenu_depth
= 0;
989 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
990 vector
= f
->menu_bar_vector
;
993 while (i
< f
->menu_bar_items_used
)
995 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
997 subprefix_stack
[submenu_depth
++] = prefix
;
1001 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1003 prefix
= subprefix_stack
[--submenu_depth
];
1006 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1008 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1009 i
+= MENU_ITEMS_PANE_LENGTH
;
1013 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1014 /* The EMACS_INT cast avoids a warning. There's no problem
1015 as long as pointers have enough bits to hold small integers. */
1016 if ((int) (EMACS_INT
) client_data
== i
)
1019 struct input_event buf
;
1023 XSETFRAME (frame
, f
);
1024 buf
.kind
= MENU_BAR_EVENT
;
1025 buf
.frame_or_window
= frame
;
1027 kbd_buffer_store_event (&buf
);
1029 for (j
= 0; j
< submenu_depth
; j
++)
1030 if (!NILP (subprefix_stack
[j
]))
1032 buf
.kind
= MENU_BAR_EVENT
;
1033 buf
.frame_or_window
= frame
;
1034 buf
.arg
= subprefix_stack
[j
];
1035 kbd_buffer_store_event (&buf
);
1040 buf
.kind
= MENU_BAR_EVENT
;
1041 buf
.frame_or_window
= frame
;
1043 kbd_buffer_store_event (&buf
);
1046 buf
.kind
= MENU_BAR_EVENT
;
1047 buf
.frame_or_window
= frame
;
1049 kbd_buffer_store_event (&buf
);
1051 f
->output_data
.mac
->menu_command_in_progress
= 0;
1052 f
->output_data
.mac
->menubar_active
= 0;
1055 i
+= MENU_ITEMS_ITEM_LENGTH
;
1058 f
->output_data
.mac
->menu_command_in_progress
= 0;
1059 f
->output_data
.mac
->menubar_active
= 0;
1062 /* Allocate a widget_value, blocking input. */
1065 xmalloc_widget_value ()
1067 widget_value
*value
;
1070 value
= malloc_widget_value ();
1076 /* This recursively calls free_widget_value on the tree of widgets.
1077 It must free all data that was malloc'ed for these widget_values.
1078 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1079 must be left alone. */
1082 free_menubar_widget_value_tree (wv
)
1087 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1089 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1091 free_menubar_widget_value_tree (wv
->contents
);
1092 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1096 free_menubar_widget_value_tree (wv
->next
);
1097 wv
->next
= (widget_value
*) 0xDEADBEEF;
1100 free_widget_value (wv
);
1104 /* Return a tree of widget_value structures for a menu bar item
1105 whose event type is ITEM_KEY (with string ITEM_NAME)
1106 and whose contents come from the list of keymaps MAPS. */
1108 static widget_value
*
1109 single_submenu (item_key
, item_name
, maps
)
1110 Lisp_Object item_key
, item_name
, maps
;
1112 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1114 int submenu_depth
= 0;
1117 Lisp_Object
*mapvec
;
1118 widget_value
**submenu_stack
;
1119 int previous_items
= menu_items_used
;
1120 int top_level_items
= 0;
1122 length
= Flength (maps
);
1123 len
= XINT (length
);
1125 /* Convert the list MAPS into a vector MAPVEC. */
1126 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1127 for (i
= 0; i
< len
; i
++)
1129 mapvec
[i
] = Fcar (maps
);
1133 menu_items_n_panes
= 0;
1135 /* Loop over the given keymaps, making a pane for each map.
1136 But don't make a pane that is empty--ignore that map instead. */
1137 for (i
= 0; i
< len
; i
++)
1139 if (SYMBOLP (mapvec
[i
])
1140 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1142 /* Here we have a command at top level in the menu bar
1143 as opposed to a submenu. */
1144 top_level_items
= 1;
1145 push_menu_pane (Qnil
, Qnil
);
1146 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1147 Qnil
, Qnil
, Qnil
, Qnil
);
1150 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1153 /* Create a tree of widget_value objects
1154 representing the panes and their items. */
1157 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1158 wv
= xmalloc_widget_value ();
1162 wv
->button_type
= BUTTON_TYPE_NONE
;
1168 /* Loop over all panes and items made during this call
1169 and construct a tree of widget_value objects.
1170 Ignore the panes and items made by previous calls to
1171 single_submenu, even though those are also in menu_items. */
1173 while (i
< menu_items_used
)
1175 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1177 submenu_stack
[submenu_depth
++] = save_wv
;
1182 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1185 save_wv
= submenu_stack
[--submenu_depth
];
1188 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1189 && submenu_depth
!= 0)
1190 i
+= MENU_ITEMS_PANE_LENGTH
;
1191 /* Ignore a nil in the item list.
1192 It's meaningful only for dialog boxes. */
1193 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1195 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1197 /* Create a new pane. */
1198 Lisp_Object pane_name
, prefix
;
1201 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1202 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1204 #ifndef HAVE_MULTILINGUAL_MENU
1205 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1207 pane_name
= ENCODE_SYSTEM (pane_name
);
1208 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1211 pane_string
= (NILP (pane_name
)
1212 ? "" : (char *) SDATA (pane_name
));
1213 /* If there is just one top-level pane, put all its items directly
1214 under the top-level menu. */
1215 if (menu_items_n_panes
== 1)
1218 /* If the pane has a meaningful name,
1219 make the pane a top-level menu item
1220 with its items as a submenu beneath it. */
1221 if (strcmp (pane_string
, ""))
1223 wv
= xmalloc_widget_value ();
1227 first_wv
->contents
= wv
;
1228 wv
->lname
= pane_name
;
1229 /* Set value to 1 so update_submenu_strings can handle '@' */
1230 wv
->value
= (char *)1;
1232 wv
->button_type
= BUTTON_TYPE_NONE
;
1237 i
+= MENU_ITEMS_PANE_LENGTH
;
1241 /* Create a new item within current pane. */
1242 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1245 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1246 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1247 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1248 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1249 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1250 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1251 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1253 #ifndef HAVE_MULTILINGUAL_MENU
1254 if (STRING_MULTIBYTE (item_name
))
1256 item_name
= ENCODE_MENU_STRING (item_name
);
1257 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1260 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1262 descrip
= ENCODE_MENU_STRING (descrip
);
1263 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1265 #endif /* not HAVE_MULTILINGUAL_MENU */
1267 wv
= xmalloc_widget_value ();
1271 save_wv
->contents
= wv
;
1273 wv
->lname
= item_name
;
1274 if (!NILP (descrip
))
1277 /* The EMACS_INT cast avoids a warning. There's no problem
1278 as long as pointers have enough bits to hold small integers. */
1279 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1280 wv
->enabled
= !NILP (enable
);
1283 wv
->button_type
= BUTTON_TYPE_NONE
;
1284 else if (EQ (type
, QCradio
))
1285 wv
->button_type
= BUTTON_TYPE_RADIO
;
1286 else if (EQ (type
, QCtoggle
))
1287 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1291 wv
->selected
= !NILP (selected
);
1292 if (!STRINGP (help
))
1299 i
+= MENU_ITEMS_ITEM_LENGTH
;
1303 /* If we have just one "menu item"
1304 that was originally a button, return it by itself. */
1305 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1307 wv
= first_wv
->contents
;
1308 free_widget_value (first_wv
);
1314 /* Walk through the widget_value tree starting at FIRST_WV and update
1315 the char * pointers from the corresponding lisp values.
1316 We do this after building the whole tree, since GC may happen while the
1317 tree is constructed, and small strings are relocated. So we must wait
1318 until no GC can happen before storing pointers into lisp values. */
1320 update_submenu_strings (first_wv
)
1321 widget_value
*first_wv
;
1325 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1327 if (STRINGP (wv
->lname
))
1329 wv
->name
= SDATA (wv
->lname
);
1331 /* Ignore the @ that means "separate pane".
1332 This is a kludge, but this isn't worth more time. */
1333 if (wv
->value
== (char *)1)
1335 if (wv
->name
[0] == '@')
1341 if (STRINGP (wv
->lkey
))
1342 wv
->key
= SDATA (wv
->lkey
);
1345 update_submenu_strings (wv
->contents
);
1350 /* Set the contents of the menubar widgets of frame F.
1351 The argument FIRST_TIME is currently ignored;
1352 it is set the first time this is called, from initialize_frame_menubar. */
1355 set_frame_menubar (f
, first_time
, deep_p
)
1360 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1362 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1365 /* We must not change the menubar when actually in use. */
1366 if (f
->output_data
.mac
->menubar_active
)
1369 XSETFRAME (Vmenu_updating_frame
, f
);
1371 if (! menubar_widget
)
1373 else if (pending_menu_activation
&& !deep_p
)
1376 wv
= xmalloc_widget_value ();
1377 wv
->name
= "menubar";
1380 wv
->button_type
= BUTTON_TYPE_NONE
;
1386 /* Make a widget-value tree representing the entire menu trees. */
1388 struct buffer
*prev
= current_buffer
;
1390 int specpdl_count
= SPECPDL_INDEX ();
1391 int previous_menu_items_used
= f
->menu_bar_items_used
;
1392 Lisp_Object
*previous_items
1393 = (Lisp_Object
*) alloca (previous_menu_items_used
1394 * sizeof (Lisp_Object
));
1396 /* If we are making a new widget, its contents are empty,
1397 do always reinitialize them. */
1398 if (! menubar_widget
)
1399 previous_menu_items_used
= 0;
1401 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1402 specbind (Qinhibit_quit
, Qt
);
1403 /* Don't let the debugger step into this code
1404 because it is not reentrant. */
1405 specbind (Qdebug_on_next_call
, Qnil
);
1407 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1408 if (NILP (Voverriding_local_map_menu_flag
))
1410 specbind (Qoverriding_terminal_local_map
, Qnil
);
1411 specbind (Qoverriding_local_map
, Qnil
);
1414 set_buffer_internal_1 (XBUFFER (buffer
));
1416 /* Run the Lucid hook. */
1417 safe_run_hooks (Qactivate_menubar_hook
);
1418 /* If it has changed current-menubar from previous value,
1419 really recompute the menubar from the value. */
1420 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1421 call0 (Qrecompute_lucid_menubar
);
1422 safe_run_hooks (Qmenu_bar_update_hook
);
1423 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1425 items
= FRAME_MENU_BAR_ITEMS (f
);
1427 /* Save the frame's previous menu bar contents data. */
1428 if (previous_menu_items_used
)
1429 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1430 previous_menu_items_used
* sizeof (Lisp_Object
));
1432 /* Fill in the current menu bar contents. */
1433 menu_items
= f
->menu_bar_vector
;
1434 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1436 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1438 Lisp_Object key
, string
, maps
;
1440 key
= XVECTOR (items
)->contents
[i
];
1441 string
= XVECTOR (items
)->contents
[i
+ 1];
1442 maps
= XVECTOR (items
)->contents
[i
+ 2];
1446 wv
= single_submenu (key
, string
, maps
);
1450 first_wv
->contents
= wv
;
1451 /* Don't set wv->name here; GC during the loop might relocate it. */
1453 wv
->button_type
= BUTTON_TYPE_NONE
;
1457 finish_menu_items ();
1459 set_buffer_internal_1 (prev
);
1460 unbind_to (specpdl_count
, Qnil
);
1462 /* If there has been no change in the Lisp-level contents
1463 of the menu bar, skip redisplaying it. Just exit. */
1465 for (i
= 0; i
< previous_menu_items_used
; i
++)
1466 if (menu_items_used
== i
1467 || (NILP (Fequal (previous_items
[i
],
1468 XVECTOR (menu_items
)->contents
[i
]))))
1470 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1472 free_menubar_widget_value_tree (first_wv
);
1478 /* Now GC cannot happen during the lifetime of the widget_value,
1479 so it's safe to store data from a Lisp_String, as long as
1480 local copies are made when the actual menu is created.
1481 Windows takes care of this for normal string items, but
1482 not for owner-drawn items or additional item-info. */
1483 wv
= first_wv
->contents
;
1484 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1487 string
= XVECTOR (items
)->contents
[i
+ 1];
1490 wv
->name
= (char *) SDATA (string
);
1491 update_submenu_strings (wv
->contents
);
1495 f
->menu_bar_vector
= menu_items
;
1496 f
->menu_bar_items_used
= menu_items_used
;
1501 /* Make a widget-value tree containing
1502 just the top level menu bar strings. */
1504 items
= FRAME_MENU_BAR_ITEMS (f
);
1505 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1509 string
= XVECTOR (items
)->contents
[i
+ 1];
1513 wv
= xmalloc_widget_value ();
1514 wv
->name
= (char *) SDATA (string
);
1517 wv
->button_type
= BUTTON_TYPE_NONE
;
1519 /* This prevents lwlib from assuming this
1520 menu item is really supposed to be empty. */
1521 /* The EMACS_INT cast avoids a warning.
1522 This value just has to be different from small integers. */
1523 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1528 first_wv
->contents
= wv
;
1532 /* Forget what we thought we knew about what is in the
1533 detailed contents of the menu bar menus.
1534 Changing the top level always destroys the contents. */
1535 f
->menu_bar_items_used
= 0;
1538 /* Create or update the menu bar widget. */
1542 /* Non-null value to indicate menubar has already been "created". */
1543 f
->output_data
.mac
->menubar_widget
= 1;
1546 int i
= MIN_MENU_ID
;
1547 MenuHandle menu
= GetMenuHandle (i
);
1548 while (menu
!= NULL
)
1552 menu
= GetMenuHandle (++i
);
1556 menu
= GetMenuHandle (i
);
1557 while (menu
!= NULL
)
1561 menu
= GetMenuHandle (++i
);
1565 fill_menubar (first_wv
->contents
);
1569 free_menubar_widget_value_tree (first_wv
);
1574 /* Called from Fx_create_frame to create the initial menubar of a frame
1575 before it is mapped, so that the window is mapped with the menubar already
1576 there instead of us tacking it on later and thrashing the window after it
1580 initialize_frame_menubar (f
)
1583 /* This function is called before the first chance to redisplay
1584 the frame. It has to be, so the frame will have the right size. */
1585 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1586 set_frame_menubar (f
, 1, 1);
1589 /* Get rid of the menu bar of frame F, and free its storage.
1590 This is used when deleting a frame, and when turning off the menu bar. */
1593 free_frame_menubar (f
)
1596 f
->output_data
.mac
->menubar_widget
= NULL
;
1600 /* mac_menu_show actually displays a menu using the panes and items in
1601 menu_items and returns the value selected from it; we assume input
1602 is blocked by the caller. */
1604 /* F is the frame the menu is for.
1605 X and Y are the frame-relative specified position,
1606 relative to the inside upper left corner of the frame F.
1607 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1608 KEYMAPS is 1 if this menu was specified with keymaps;
1609 in that case, we return a list containing the chosen item's value
1610 and perhaps also the pane's prefix.
1611 TITLE is the specified menu title.
1612 ERROR is a place to store an error message string in case of failure.
1613 (We return nil on failure, but the value doesn't actually matter.) */
1616 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1627 int menu_item_choice
;
1628 int menu_item_selection
;
1631 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1632 widget_value
**submenu_stack
1633 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1634 Lisp_Object
*subprefix_stack
1635 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1636 int submenu_depth
= 0;
1641 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1643 *error
= "Empty menu";
1647 /* Create a tree of widget_value objects
1648 representing the panes and their items. */
1649 wv
= xmalloc_widget_value ();
1653 wv
->button_type
= BUTTON_TYPE_NONE
;
1658 /* Loop over all panes and items, filling in the tree. */
1660 while (i
< menu_items_used
)
1662 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1664 submenu_stack
[submenu_depth
++] = save_wv
;
1670 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1673 save_wv
= submenu_stack
[--submenu_depth
];
1677 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1678 && submenu_depth
!= 0)
1679 i
+= MENU_ITEMS_PANE_LENGTH
;
1680 /* Ignore a nil in the item list.
1681 It's meaningful only for dialog boxes. */
1682 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1684 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1686 /* Create a new pane. */
1687 Lisp_Object pane_name
, prefix
;
1689 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1690 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1691 #ifndef HAVE_MULTILINGUAL_MENU
1692 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1694 pane_name
= ENCODE_SYSTEM (pane_name
);
1695 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1698 pane_string
= (NILP (pane_name
)
1699 ? "" : (char *) SDATA (pane_name
));
1700 /* If there is just one top-level pane, put all its items directly
1701 under the top-level menu. */
1702 if (menu_items_n_panes
== 1)
1705 /* If the pane has a meaningful name,
1706 make the pane a top-level menu item
1707 with its items as a submenu beneath it. */
1708 if (!keymaps
&& strcmp (pane_string
, ""))
1710 wv
= xmalloc_widget_value ();
1714 first_wv
->contents
= wv
;
1715 wv
->name
= pane_string
;
1716 if (keymaps
&& !NILP (prefix
))
1720 wv
->button_type
= BUTTON_TYPE_NONE
;
1725 else if (first_pane
)
1731 i
+= MENU_ITEMS_PANE_LENGTH
;
1735 /* Create a new item within current pane. */
1736 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1738 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1739 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1740 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1741 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1742 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1743 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1744 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1746 #ifndef HAVE_MULTILINGUAL_MENU
1747 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1749 item_name
= ENCODE_MENU_STRING (item_name
);
1750 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1752 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1754 descrip
= ENCODE_MENU_STRING (descrip
);
1755 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1757 #endif /* not HAVE_MULTILINGUAL_MENU */
1759 wv
= xmalloc_widget_value ();
1763 save_wv
->contents
= wv
;
1764 wv
->name
= (char *) SDATA (item_name
);
1765 if (!NILP (descrip
))
1766 wv
->key
= (char *) SDATA (descrip
);
1768 /* Use the contents index as call_data, since we are
1769 restricted to 16-bits. */
1770 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1771 wv
->enabled
= !NILP (enable
);
1774 wv
->button_type
= BUTTON_TYPE_NONE
;
1775 else if (EQ (type
, QCtoggle
))
1776 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1777 else if (EQ (type
, QCradio
))
1778 wv
->button_type
= BUTTON_TYPE_RADIO
;
1782 wv
->selected
= !NILP (selected
);
1783 if (!STRINGP (help
))
1790 i
+= MENU_ITEMS_ITEM_LENGTH
;
1794 /* Deal with the title, if it is non-nil. */
1797 widget_value
*wv_title
= xmalloc_widget_value ();
1798 widget_value
*wv_sep
= xmalloc_widget_value ();
1800 /* Maybe replace this separator with a bitmap or owner-draw item
1801 so that it looks better. Having two separators looks odd. */
1802 wv_sep
->name
= "--";
1803 wv_sep
->next
= first_wv
->contents
;
1804 wv_sep
->help
= Qnil
;
1806 #ifndef HAVE_MULTILINGUAL_MENU
1807 if (STRING_MULTIBYTE (title
))
1808 title
= ENCODE_MENU_STRING (title
);
1810 wv_title
->name
= (char *) SDATA (title
);
1811 wv_title
->enabled
= TRUE
;
1812 wv_title
->title
= TRUE
;
1813 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1814 wv_title
->help
= Qnil
;
1815 wv_title
->next
= wv_sep
;
1816 first_wv
->contents
= wv_title
;
1819 /* Actually create the menu. */
1820 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1821 submenu_id
= MIN_POPUP_SUBMENU_ID
;
1822 fill_submenu (menu
, first_wv
->contents
);
1824 /* Adjust coordinates to be root-window-relative. */
1828 SetPortWindowPort (FRAME_MAC_WINDOW (f
));
1830 LocalToGlobal (&pos
);
1832 /* No selection has been chosen yet. */
1833 menu_item_choice
= 0;
1834 menu_item_selection
= 0;
1836 InsertMenu (menu
, -1);
1838 /* Display the menu. */
1839 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
1840 menu_item_selection
= LoWord (menu_item_choice
);
1842 /* Get the refcon to find the correct item*/
1843 if (menu_item_selection
)
1845 MenuHandle sel_menu
= GetMenuHandle (HiWord (menu_item_choice
));
1847 GetMenuItemRefCon (sel_menu
, menu_item_selection
, &refcon
);
1852 /* Clean up extraneous mouse events which might have been generated
1854 discard_mouse_events ();
1857 /* Must reset this manually because the button release event is not
1858 passed to Emacs event loop. */
1859 FRAME_MAC_DISPLAY_INFO (f
)->grabbed
= 0;
1861 /* Free the widget_value objects we used to specify the
1863 free_menubar_widget_value_tree (first_wv
);
1865 /* delete all menus */
1867 int i
= MIN_POPUP_SUBMENU_ID
;
1868 MenuHandle submenu
= GetMenuHandle (i
);
1869 while (submenu
!= NULL
)
1872 DisposeMenu (submenu
);
1873 submenu
= GetMenuHandle (++i
);
1877 DeleteMenu (POPUP_SUBMENU_ID
);
1880 /* Find the selected item, and its pane, to return
1881 the proper value. */
1882 if (menu_item_selection
!= 0)
1884 Lisp_Object prefix
, entry
;
1886 prefix
= entry
= Qnil
;
1888 while (i
< menu_items_used
)
1890 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1892 subprefix_stack
[submenu_depth
++] = prefix
;
1896 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1898 prefix
= subprefix_stack
[--submenu_depth
];
1901 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1904 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1905 i
+= MENU_ITEMS_PANE_LENGTH
;
1907 /* Ignore a nil in the item list.
1908 It's meaningful only for dialog boxes. */
1909 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1914 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1915 if ((int) (EMACS_INT
) refcon
== i
)
1921 entry
= Fcons (entry
, Qnil
);
1923 entry
= Fcons (prefix
, entry
);
1924 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1925 if (!NILP (subprefix_stack
[j
]))
1926 entry
= Fcons (subprefix_stack
[j
], entry
);
1930 i
+= MENU_ITEMS_ITEM_LENGTH
;
1940 /* Construct native Mac OS menubar based on widget_value tree. */
1943 mac_dialog (widget_value
*wv
)
1947 char **button_labels
;
1954 WindowPtr window_ptr
;
1957 EventRecord event_record
;
1959 int control_part_code
;
1962 dialog_name
= wv
->name
;
1963 nb_buttons
= dialog_name
[1] - '0';
1964 left_count
= nb_buttons
- (dialog_name
[4] - '0');
1965 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
1966 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
1969 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
1970 strcpy (prompt
, wv
->value
);
1974 for (i
= 0; i
< nb_buttons
; i
++)
1976 button_labels
[i
] = wv
->value
;
1977 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
1978 strcpy (button_labels
[i
], wv
->value
);
1979 c2pstr (button_labels
[i
]);
1980 ref_cons
[i
] = (UInt32
) wv
->call_data
;
1984 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
1986 SetPortWindowPort (window_ptr
);
1989 /* Left and right margins in the dialog are 13 pixels each.*/
1991 /* Calculate width of dialog box: 8 pixels on each side of the text
1992 label in each button, 12 pixels between buttons. */
1993 for (i
= 0; i
< nb_buttons
; i
++)
1994 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1996 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1999 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
2001 SizeWindow (window_ptr
, dialog_width
, 78, 0);
2002 ShowWindow (window_ptr
);
2004 SetPortWindowPort (window_ptr
);
2009 DrawString (prompt
);
2012 for (i
= 0; i
< nb_buttons
; i
++)
2014 int button_width
= StringWidth (button_labels
[i
]) + 16;
2015 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
2016 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
2017 kControlPushButtonProc
, ref_cons
[i
]);
2018 left
+= button_width
+ 12;
2019 if (i
== left_count
- 1)
2026 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
2027 if (event_record
.what
== mouseDown
)
2029 part_code
= FindWindow (event_record
.where
, &window_ptr
);
2030 if (part_code
== inContent
)
2032 mouse
= event_record
.where
;
2033 GlobalToLocal (&mouse
);
2034 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2035 if (control_part_code
== kControlButtonPart
)
2036 if (TrackControl (ch
, mouse
, NULL
))
2037 i
= GetControlReference (ch
);
2042 DisposeWindow (window_ptr
);
2047 static char * button_names
[] = {
2048 "button1", "button2", "button3", "button4", "button5",
2049 "button6", "button7", "button8", "button9", "button10" };
2052 mac_dialog_show (f
, keymaps
, title
, header
, error
)
2055 Lisp_Object title
, header
;
2058 int i
, nb_buttons
=0;
2059 char dialog_name
[6];
2060 int menu_item_selection
;
2062 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2064 /* Number of elements seen so far, before boundary. */
2066 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2067 int boundary_seen
= 0;
2071 if (menu_items_n_panes
> 1)
2073 *error
= "Multiple panes in dialog box";
2077 /* Create a tree of widget_value objects
2078 representing the text label and buttons. */
2080 Lisp_Object pane_name
, prefix
;
2082 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2083 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2084 pane_string
= (NILP (pane_name
)
2085 ? "" : (char *) SDATA (pane_name
));
2086 prev_wv
= xmalloc_widget_value ();
2087 prev_wv
->value
= pane_string
;
2088 if (keymaps
&& !NILP (prefix
))
2090 prev_wv
->enabled
= 1;
2091 prev_wv
->name
= "message";
2092 prev_wv
->help
= Qnil
;
2095 /* Loop over all panes and items, filling in the tree. */
2096 i
= MENU_ITEMS_PANE_LENGTH
;
2097 while (i
< menu_items_used
)
2100 /* Create a new item within current pane. */
2101 Lisp_Object item_name
, enable
, descrip
, help
;
2103 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2104 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2106 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2107 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2109 if (NILP (item_name
))
2111 free_menubar_widget_value_tree (first_wv
);
2112 *error
= "Submenu in dialog items";
2115 if (EQ (item_name
, Qquote
))
2117 /* This is the boundary between left-side elts
2118 and right-side elts. Stop incrementing right_count. */
2123 if (nb_buttons
>= 9)
2125 free_menubar_widget_value_tree (first_wv
);
2126 *error
= "Too many dialog items";
2130 wv
= xmalloc_widget_value ();
2132 wv
->name
= (char *) button_names
[nb_buttons
];
2133 if (!NILP (descrip
))
2134 wv
->key
= (char *) SDATA (descrip
);
2135 wv
->value
= (char *) SDATA (item_name
);
2136 wv
->call_data
= (void *) i
;
2137 /* menu item is identified by its index in menu_items table */
2138 wv
->enabled
= !NILP (enable
);
2142 if (! boundary_seen
)
2146 i
+= MENU_ITEMS_ITEM_LENGTH
;
2149 /* If the boundary was not specified,
2150 by default put half on the left and half on the right. */
2151 if (! boundary_seen
)
2152 left_count
= nb_buttons
- nb_buttons
/ 2;
2154 wv
= xmalloc_widget_value ();
2155 wv
->name
= dialog_name
;
2158 /* Frame title: 'Q' = Question, 'I' = Information.
2159 Can also have 'E' = Error if, one day, we want
2160 a popup for errors. */
2162 dialog_name
[0] = 'Q';
2164 dialog_name
[0] = 'I';
2166 /* Dialog boxes use a really stupid name encoding
2167 which specifies how many buttons to use
2168 and how many buttons are on the right. */
2169 dialog_name
[1] = '0' + nb_buttons
;
2170 dialog_name
[2] = 'B';
2171 dialog_name
[3] = 'R';
2172 /* Number of buttons to put on the right. */
2173 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2175 wv
->contents
= first_wv
;
2179 /* Actually create the dialog. */
2181 menu_item_selection
= mac_dialog (first_wv
);
2183 menu_item_selection
= 0;
2186 /* Free the widget_value objects we used to specify the contents. */
2187 free_menubar_widget_value_tree (first_wv
);
2189 /* Find the selected item, and its pane, to return the proper
2191 if (menu_item_selection
!= 0)
2197 while (i
< menu_items_used
)
2201 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2204 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2205 i
+= MENU_ITEMS_PANE_LENGTH
;
2210 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2211 if (menu_item_selection
== i
)
2215 entry
= Fcons (entry
, Qnil
);
2217 entry
= Fcons (prefix
, entry
);
2221 i
+= MENU_ITEMS_ITEM_LENGTH
;
2228 #endif /* HAVE_DIALOGS */
2231 /* Is this item a separator? */
2233 name_is_separator (name
)
2238 /* Check if name string consists of only dashes ('-'). */
2239 while (*name
== '-') name
++;
2240 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2241 or "--deep-shadow". We don't implement them yet, se we just treat
2242 them like normal separators. */
2243 return (*name
== '\0' || start
+ 2 == name
);
2247 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
,
2253 if (name_is_separator (wv
->name
))
2254 AppendMenu (menu
, "\p-");
2257 AppendMenu (menu
, "\pX");
2259 #if TARGET_API_MAC_CARBON
2260 pos
= CountMenuItems (menu
);
2262 pos
= CountMItems (menu
);
2265 strcpy (item_name
, "");
2266 strncat (item_name
, wv
->name
, 255);
2267 if (wv
->key
!= NULL
)
2269 strncat (item_name
, " ", 255);
2270 strncat (item_name
, wv
->key
, 255);
2273 #if TARGET_API_MAC_CARBON
2275 CFStringRef string
= cfstring_create_with_utf8_cstring (item_name
);
2277 SetMenuItemTextWithCFString (menu
, pos
, string
);
2282 SetMenuItemText (menu
, pos
, item_name
);
2285 if (wv
->enabled
&& !force_disable
)
2286 #if TARGET_API_MAC_CARBON
2287 EnableMenuItem (menu
, pos
);
2289 EnableItem (menu
, pos
);
2292 #if TARGET_API_MAC_CARBON
2293 DisableMenuItem (menu
, pos
);
2295 DisableItem (menu
, pos
);
2298 /* Draw radio buttons and tickboxes. */
2300 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2301 wv
->button_type
== BUTTON_TYPE_RADIO
))
2302 SetItemMark (menu
, pos
, checkMark
);
2304 SetItemMark (menu
, pos
, noMark
);
2307 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2310 if (submenu
!= NULL
)
2311 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2314 /* Construct native Mac OS menubar based on widget_value tree. */
2317 fill_submenu (MenuHandle menu
, widget_value
*wv
)
2319 for ( ; wv
!= NULL
; wv
= wv
->next
)
2322 int cur_submenu
= submenu_id
++;
2323 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2324 fill_submenu (submenu
, wv
->contents
);
2325 InsertMenu (submenu
, -1);
2326 add_menu_item (menu
, wv
, cur_submenu
, 0);
2329 add_menu_item (menu
, wv
, NULL
, 0);
2333 /* Construct native Mac OS menu based on widget_value tree. */
2336 fill_menu (MenuHandle menu
, widget_value
*wv
)
2338 for ( ; wv
!= NULL
; wv
= wv
->next
)
2341 int cur_submenu
= submenu_id
++;
2342 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2343 fill_submenu (submenu
, wv
->contents
);
2344 InsertMenu (submenu
, -1);
2345 add_menu_item (menu
, wv
, cur_submenu
, 0);
2348 add_menu_item (menu
, wv
, NULL
, 0);
2351 /* Construct native Mac OS menubar based on widget_value tree. */
2354 fill_menubar (widget_value
*wv
)
2358 submenu_id
= MIN_SUBMENU_ID
;
2360 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2365 strncpy (title
, wv
->name
, 255);
2368 menu
= NewMenu (id
, title
);
2371 fill_menu (menu
, wv
->contents
);
2373 InsertMenu (menu
, 0);
2377 #endif /* HAVE_MENUS */
2383 staticpro (&menu_items
);
2386 Qdebug_on_next_call
= intern ("debug-on-next-call");
2387 staticpro (&Qdebug_on_next_call
);
2389 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2390 doc
: /* Frame for which we are updating a menu.
2391 The enable predicate for a menu command should check this variable. */);
2392 Vmenu_updating_frame
= Qnil
;
2394 defsubr (&Sx_popup_menu
);
2396 defsubr (&Sx_popup_dialog
);
2400 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2401 (do not change this comment) */