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). */
28 #include "termhooks.h"
33 #include "blockinput.h"
41 #include <QuickDraw.h>
42 #include <ToolUtils.h>
47 #if defined (__MRC__) || (__MSL__ >= 0x6000)
48 #include <ControlDefinitions.h>
50 #endif /* not MAC_OSX */
52 /* This may include sys/types.h, and that somehow loses
53 if this is not done before the other system files. */
56 /* Load sys/types.h if not already loaded.
57 In some systems loading it twice is suicidal. */
59 #include <sys/types.h>
62 #include "dispextern.h"
64 #define POPUP_SUBMENU_ID 235
65 #define MIN_POPUP_SUBMENU_ID 512
66 #define MIN_MENU_ID 256
67 #define MIN_SUBMENU_ID 1
69 #define DIALOG_WINDOW_RESOURCE 130
71 #define HAVE_DIALOGS 1
73 #undef HAVE_MULTILINGUAL_MENU
74 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
76 /******************************************************************/
77 /* Definitions copied from lwlib.h */
79 typedef void * XtPointer
;
88 /* This structure is based on the one in ../lwlib/lwlib.h, modified
90 typedef struct _widget_value
95 /* value (meaning depend on widget type) */
97 /* keyboard equivalent. no implications for XtTranslations */
100 /* Help string or nil if none.
101 GC finds this string through the frame's menu_bar_vector
102 or through menu_items. */
104 /* true if enabled */
106 /* true if selected */
108 /* The type of a button. */
109 enum button_type button_type
;
110 /* true if menu title */
113 /* true if was edited (maintained by get_value) */
115 /* true if has changed (maintained by lw library) */
117 /* true if this widget itself has changed,
118 but not counting the other widgets found in the `next' field. */
119 change_type this_one_change
;
121 /* Contents of the sub-widgets, also selected slot for checkbox */
122 struct _widget_value
* contents
;
123 /* data passed to callback */
125 /* next one in the list */
126 struct _widget_value
* next
;
128 /* slot for the toolkit dependent part. Always initialize to NULL. */
130 /* tell us if we should free the toolkit data slot when freeing the
131 widget_value itself. */
132 Boolean free_toolkit_data
;
134 /* we resource the widget_value structures; this points to the next
135 one on the free list if this one has been deallocated.
137 struct _widget_value
*free_list
;
141 /* Assumed by other routines to zero area returned. */
142 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
143 0, (sizeof (widget_value)))
144 #define free_widget_value(wv) xfree (wv)
146 /******************************************************************/
153 Lisp_Object Vmenu_updating_frame
;
155 Lisp_Object Qdebug_on_next_call
;
157 extern Lisp_Object Qmenu_bar
;
159 extern Lisp_Object QCtoggle
, QCradio
;
161 extern Lisp_Object Voverriding_local_map
;
162 extern Lisp_Object Voverriding_local_map_menu_flag
;
164 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
166 extern Lisp_Object Qmenu_bar_update_hook
;
168 #if TARGET_API_MAC_CARBON
169 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
171 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
174 void set_frame_menubar ();
176 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
177 Lisp_Object
, Lisp_Object
, Lisp_Object
,
178 Lisp_Object
, Lisp_Object
));
180 static Lisp_Object
mac_dialog_show ();
182 static Lisp_Object
mac_menu_show ();
184 static void keymap_panes ();
185 static void single_keymap_panes ();
186 static void single_menu_item ();
187 static void list_of_panes ();
188 static void list_of_items ();
190 static void fill_submenu (MenuHandle
, widget_value
*);
191 static void fill_menubar (widget_value
*);
194 /* This holds a Lisp vector that holds the results of decoding
195 the keymaps or alist-of-alists that specify a menu.
197 It describes the panes and items within the panes.
199 Each pane is described by 3 elements in the vector:
200 t, the pane name, the pane's prefix key.
201 Then follow the pane's items, with 5 elements per item:
202 the item string, the enable flag, the item's value,
203 the definition, and the equivalent keyboard key's description string.
205 In some cases, multiple levels of menus may be described.
206 A single vector slot containing nil indicates the start of a submenu.
207 A single vector slot containing lambda indicates the end of a submenu.
208 The submenu follows a menu item which is the way to reach the submenu.
210 A single vector slot containing quote indicates that the
211 following items should appear on the right of a dialog box.
213 Using a Lisp vector to hold this information while we decode it
214 takes care of protecting all the data from GC. */
216 #define MENU_ITEMS_PANE_NAME 1
217 #define MENU_ITEMS_PANE_PREFIX 2
218 #define MENU_ITEMS_PANE_LENGTH 3
222 MENU_ITEMS_ITEM_NAME
= 0,
223 MENU_ITEMS_ITEM_ENABLE
,
224 MENU_ITEMS_ITEM_VALUE
,
225 MENU_ITEMS_ITEM_EQUIV_KEY
,
226 MENU_ITEMS_ITEM_DEFINITION
,
227 MENU_ITEMS_ITEM_TYPE
,
228 MENU_ITEMS_ITEM_SELECTED
,
229 MENU_ITEMS_ITEM_HELP
,
230 MENU_ITEMS_ITEM_LENGTH
233 static Lisp_Object menu_items
;
235 /* Number of slots currently allocated in menu_items. */
236 static int menu_items_allocated
;
238 /* This is the index in menu_items of the first empty slot. */
239 static int menu_items_used
;
241 /* The number of panes currently recorded in menu_items,
242 excluding those within submenus. */
243 static int menu_items_n_panes
;
245 /* Current depth within submenus. */
246 static int menu_items_submenu_depth
;
248 /* Flag which when set indicates a dialog or menu has been posted by
249 Xt on behalf of one of the widget sets. */
250 static int popup_activated_flag
;
252 /* Index of the next submenu */
253 static int submenu_id
;
255 static int next_menubar_widget_id
;
257 /* This is set nonzero after the user activates the menu bar, and set
258 to zero again after the menu bars are redisplayed by prepare_menu_bar.
259 While it is nonzero, all calls to set_frame_menubar go deep.
261 I don't understand why this is needed, but it does seem to be
262 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
264 int pending_menu_activation
;
266 /* Initialize the menu_items structure if we haven't already done so.
267 Also mark it as currently empty. */
272 if (NILP (menu_items
))
274 menu_items_allocated
= 60;
275 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
279 menu_items_n_panes
= 0;
280 menu_items_submenu_depth
= 0;
283 /* Call at the end of generating the data in menu_items.
284 This fills in the number of items in the last pane. */
291 /* Call when finished using the data for the current menu
295 discard_menu_items ()
297 /* Free the structure if it is especially large.
298 Otherwise, hold on to it, to save time. */
299 if (menu_items_allocated
> 200)
302 menu_items_allocated
= 0;
306 /* Make the menu_items vector twice as large. */
312 int old_size
= menu_items_allocated
;
315 menu_items_allocated
*= 2;
316 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
317 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
318 old_size
* sizeof (Lisp_Object
));
321 /* Begin a submenu. */
324 push_submenu_start ()
326 if (menu_items_used
+ 1 > menu_items_allocated
)
329 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
330 menu_items_submenu_depth
++;
338 if (menu_items_used
+ 1 > menu_items_allocated
)
341 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
342 menu_items_submenu_depth
--;
345 /* Indicate boundary between left and right. */
348 push_left_right_boundary ()
350 if (menu_items_used
+ 1 > menu_items_allocated
)
353 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
356 /* Start a new menu pane in menu_items.
357 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
360 push_menu_pane (name
, prefix_vec
)
361 Lisp_Object name
, prefix_vec
;
363 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
366 if (menu_items_submenu_depth
== 0)
367 menu_items_n_panes
++;
368 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
369 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
370 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
373 /* Push one menu item into the current pane. NAME is the string to
374 display. ENABLE if non-nil means this item can be selected. KEY
375 is the key generated by choosing this item, or nil if this item
376 doesn't really have a definition. DEF is the definition of this
377 item. EQUIV is the textual description of the keyboard equivalent
378 for this item (or nil if none). TYPE is the type of this menu
379 item, one of nil, `toggle' or `radio'. */
382 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
383 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
385 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
388 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
389 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
390 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
391 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
392 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
393 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
394 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
395 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
398 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
399 and generate menu panes for them in menu_items.
400 If NOTREAL is nonzero,
401 don't bother really computing whether an item is enabled. */
404 keymap_panes (keymaps
, nmaps
, notreal
)
405 Lisp_Object
*keymaps
;
413 /* Loop over the given keymaps, making a pane for each map.
414 But don't make a pane that is empty--ignore that map instead.
415 P is the number of panes we have made so far. */
416 for (mapno
= 0; mapno
< nmaps
; mapno
++)
417 single_keymap_panes (keymaps
[mapno
],
418 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
420 finish_menu_items ();
423 /* This is a recursive subroutine of keymap_panes.
424 It handles one keymap, KEYMAP.
425 The other arguments are passed along
426 or point to local variables of the previous function.
427 If NOTREAL is nonzero, only check for equivalent key bindings, don't
428 evaluate expressions in menu items and don't make any menu.
430 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
433 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
435 Lisp_Object pane_name
;
440 Lisp_Object pending_maps
= Qnil
;
441 Lisp_Object tail
, item
;
442 struct gcpro gcpro1
, gcpro2
;
447 push_menu_pane (pane_name
, prefix
);
449 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
451 GCPRO2 (keymap
, pending_maps
);
452 /* Look at each key binding, and if it is a menu item add it
456 single_menu_item (XCAR (item
), XCDR (item
),
457 &pending_maps
, notreal
, maxdepth
);
458 else if (VECTORP (item
))
460 /* Loop over the char values represented in the vector. */
461 int len
= XVECTOR (item
)->size
;
463 for (c
= 0; c
< len
; c
++)
465 Lisp_Object character
;
466 XSETFASTINT (character
, c
);
467 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
468 &pending_maps
, notreal
, maxdepth
);
474 /* Process now any submenus which want to be panes at this level. */
475 while (!NILP (pending_maps
))
477 Lisp_Object elt
, eltcdr
, string
;
478 elt
= Fcar (pending_maps
);
480 string
= XCAR (eltcdr
);
481 /* We no longer discard the @ from the beginning of the string here.
482 Instead, we do this in mac_menu_show. */
483 single_keymap_panes (Fcar (elt
), string
,
484 XCDR (eltcdr
), notreal
, maxdepth
- 1);
485 pending_maps
= Fcdr (pending_maps
);
489 /* This is a subroutine of single_keymap_panes that handles one
491 KEY is a key in a keymap and ITEM is its binding.
492 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
494 If NOTREAL is nonzero, only check for equivalent key bindings, don't
495 evaluate expressions in menu items and don't make any menu.
496 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
499 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
500 Lisp_Object key
, item
;
501 Lisp_Object
*pending_maps_ptr
;
502 int maxdepth
, notreal
;
504 Lisp_Object map
, item_string
, enabled
;
505 struct gcpro gcpro1
, gcpro2
;
508 /* Parse the menu item and leave the result in item_properties. */
510 res
= parse_menu_item (item
, notreal
, 0);
513 return; /* Not a menu item. */
515 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
519 /* We don't want to make a menu, just traverse the keymaps to
520 precompute equivalent key bindings. */
522 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
526 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
527 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
529 if (!NILP (map
) && SREF (item_string
, 0) == '@')
532 /* An enabled separate pane. Remember this to handle it later. */
533 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
538 push_menu_item (item_string
, enabled
, key
,
539 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
540 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
541 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
542 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
543 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
545 /* Display a submenu using the toolkit. */
546 if (! (NILP (map
) || NILP (enabled
)))
548 push_submenu_start ();
549 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
554 /* Push all the panes and items of a menu described by the
555 alist-of-alists MENU.
556 This handles old-fashioned calls to x-popup-menu. */
566 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
568 Lisp_Object elt
, pane_name
, pane_data
;
570 pane_name
= Fcar (elt
);
571 CHECK_STRING (pane_name
);
572 push_menu_pane (pane_name
, Qnil
);
573 pane_data
= Fcdr (elt
);
574 CHECK_CONS (pane_data
);
575 list_of_items (pane_data
);
578 finish_menu_items ();
581 /* Push the items in a single pane defined by the alist PANE. */
587 Lisp_Object tail
, item
, item1
;
589 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
593 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
594 else if (NILP (item
))
595 push_left_right_boundary ();
600 CHECK_STRING (item1
);
601 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
606 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
607 doc
: /* Pop up a deck-of-cards menu and return user's selection.
608 POSITION is a position specification. This is either a mouse button
609 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
610 are positions in pixels from the top left corner of WINDOW's frame
611 \(WINDOW may be a frame object instead of a window). This controls the
612 position of the center of the first line in the first pane of the
613 menu, not the top left of the menu as a whole. If POSITION is t, it
614 means to use the current mouse position.
616 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
617 The menu items come from key bindings that have a menu string as well as
618 a definition; actually, the \"definition\" in such a key binding looks like
619 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
620 the keymap as a top-level element.
622 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
623 Otherwise, REAL-DEFINITION should be a valid key binding definition.
625 You can also use a list of keymaps as MENU. Then each keymap makes a
626 separate pane. When MENU is a keymap or a list of keymaps, the return
627 value is a list of events.
629 Alternatively, you can specify a menu of multiple panes with a list of
630 the form (TITLE PANE1 PANE2...), where each pane is a list of
631 form (TITLE ITEM1 ITEM2...).
632 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
633 appear as an item--that makes a nonselectable line in the menu.
634 With this form of menu, the return value is VALUE from the chosen item.
636 If POSITION is nil, don't display the menu at all, just precalculate the
637 cached information about equivalent key sequences. */)
639 Lisp_Object position
, menu
;
641 Lisp_Object keymap
, tem
;
642 int xpos
= 0, ypos
= 0;
645 Lisp_Object selection
;
647 Lisp_Object x
, y
, window
;
653 if (! NILP (position
))
657 /* Decode the first argument: find the window and the coordinates. */
658 if (EQ (position
, Qt
)
659 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
660 || EQ (XCAR (position
), Qtool_bar
))))
662 /* Use the mouse's current position. */
663 FRAME_PTR new_f
= SELECTED_FRAME ();
664 Lisp_Object bar_window
;
665 enum scroll_bar_part part
;
668 if (mouse_position_hook
)
669 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
670 &part
, &x
, &y
, &time
);
672 XSETFRAME (window
, new_f
);
675 window
= selected_window
;
682 tem
= Fcar (position
);
685 window
= Fcar (Fcdr (position
));
687 y
= Fcar (Fcdr (tem
));
692 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
693 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
694 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
703 /* Decode where to put the menu. */
711 else if (WINDOWP (window
))
713 CHECK_LIVE_WINDOW (window
);
714 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
716 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
717 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
720 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
721 but I don't want to make one now. */
722 CHECK_WINDOW (window
);
727 XSETFRAME (Vmenu_updating_frame
, f
);
729 Vmenu_updating_frame
= Qnil
;
730 #endif /* HAVE_MENUS */
735 /* Decode the menu items from what was specified. */
737 keymap
= get_keymap (menu
, 0, 0);
740 /* We were given a keymap. Extract menu info from the keymap. */
743 /* Extract the detailed info to make one pane. */
744 keymap_panes (&menu
, 1, NILP (position
));
746 /* Search for a string appearing directly as an element of the keymap.
747 That string is the title of the menu. */
748 prompt
= Fkeymap_prompt (keymap
);
749 if (NILP (title
) && !NILP (prompt
))
752 /* Make that be the pane title of the first pane. */
753 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
754 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
758 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
760 /* We were given a list of keymaps. */
761 int nmaps
= XFASTINT (Flength (menu
));
763 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
768 /* The first keymap that has a prompt string
769 supplies the menu title. */
770 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
774 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
776 prompt
= Fkeymap_prompt (keymap
);
777 if (NILP (title
) && !NILP (prompt
))
781 /* Extract the detailed info to make one pane. */
782 keymap_panes (maps
, nmaps
, NILP (position
));
784 /* Make the title be the pane title of the first pane. */
785 if (!NILP (title
) && menu_items_n_panes
>= 0)
786 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
792 /* We were given an old-fashioned menu. */
794 CHECK_STRING (title
);
796 list_of_panes (Fcdr (menu
));
803 discard_menu_items ();
809 /* Display them in a menu. */
812 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
813 keymaps
, title
, &error_name
);
816 discard_menu_items ();
819 #endif /* HAVE_MENUS */
821 if (error_name
) error (error_name
);
827 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
828 doc
: /* Pop up a dialog box and return user's selection.
829 POSITION specifies which frame to use.
830 This is normally a mouse button event or a window or frame.
831 If POSITION is t, it means to use the frame the mouse is on.
832 The dialog box appears in the middle of the specified frame.
834 CONTENTS specifies the alternatives to display in the dialog box.
835 It is a list of the form (TITLE ITEM1 ITEM2...).
836 Each ITEM is a cons cell (STRING . VALUE).
837 The return value is VALUE from the chosen item.
839 An ITEM may also be just a string--that makes a nonselectable item.
840 An ITEM may also be nil--that means to put all preceding items
841 on the left of the dialog box and all following items on the right.
842 \(By default, approximately half appear on each side.) */)
844 Lisp_Object position
, contents
;
851 /* Decode the first argument: find the window or frame to use. */
852 if (EQ (position
, Qt
)
853 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
854 || EQ (XCAR (position
), Qtool_bar
))))
856 #if 0 /* Using the frame the mouse is on may not be right. */
857 /* Use the mouse's current position. */
858 FRAME_PTR new_f
= SELECTED_FRAME ();
859 Lisp_Object bar_window
;
860 enum scroll_bar_part part
;
864 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
867 XSETFRAME (window
, new_f
);
869 window
= selected_window
;
871 window
= selected_window
;
873 else if (CONSP (position
))
876 tem
= Fcar (position
);
878 window
= Fcar (Fcdr (position
));
881 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
882 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
885 else if (WINDOWP (position
) || FRAMEP (position
))
890 /* Decode where to put the menu. */
894 else if (WINDOWP (window
))
896 CHECK_LIVE_WINDOW (window
);
897 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
900 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
901 but I don't want to make one now. */
902 CHECK_WINDOW (window
);
905 /* Display a menu with these alternatives
906 in the middle of frame F. */
908 Lisp_Object x
, y
, frame
, newpos
;
909 XSETFRAME (frame
, f
);
910 XSETINT (x
, x_pixel_width (f
) / 2);
911 XSETINT (y
, x_pixel_height (f
) / 2);
912 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
914 return Fx_popup_menu (newpos
,
915 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
917 #else /* HAVE_DIALOGS */
921 Lisp_Object selection
;
923 /* Decode the dialog items from what was specified. */
924 title
= Fcar (contents
);
925 CHECK_STRING (title
);
927 list_of_panes (Fcons (contents
, Qnil
));
929 /* Display them in a dialog box. */
931 selection
= mac_dialog_show (f
, 0, title
, &error_name
);
934 discard_menu_items ();
936 if (error_name
) error (error_name
);
939 #endif /* HAVE_DIALOGS */
942 /* Activate the menu bar of frame F.
943 This is called from keyboard.c when it gets the
944 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
946 To activate the menu bar, we signal to the input thread that it can
947 return from the WM_INITMENU message, allowing the normal Windows
948 processing of the menus.
950 But first we recompute the menu bar contents (the whole tree).
952 This way we can safely execute Lisp code. */
955 x_activate_menubar (f
)
959 extern Point saved_menu_event_location
;
961 set_frame_menubar (f
, 0, 1);
964 menu_choice
= MenuSelect (saved_menu_event_location
);
965 do_menu_choice (menu_choice
);
970 /* This callback is called from the menu bar pulldown menu
971 when the user makes a selection.
972 Figure out what the user chose
973 and put the appropriate events into the keyboard buffer. */
976 menubar_selection_callback (FRAME_PTR f
, int client_data
)
978 Lisp_Object prefix
, entry
;
980 Lisp_Object
*subprefix_stack
;
981 int submenu_depth
= 0;
987 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
988 vector
= f
->menu_bar_vector
;
991 while (i
< f
->menu_bar_items_used
)
993 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
995 subprefix_stack
[submenu_depth
++] = prefix
;
999 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1001 prefix
= subprefix_stack
[--submenu_depth
];
1004 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1006 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1007 i
+= MENU_ITEMS_PANE_LENGTH
;
1011 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1012 /* The EMACS_INT cast avoids a warning. There's no problem
1013 as long as pointers have enough bits to hold small integers. */
1014 if ((int) (EMACS_INT
) client_data
== i
)
1017 struct input_event buf
;
1021 XSETFRAME (frame
, f
);
1022 buf
.kind
= MENU_BAR_EVENT
;
1023 buf
.frame_or_window
= frame
;
1025 kbd_buffer_store_event (&buf
);
1027 for (j
= 0; j
< submenu_depth
; j
++)
1028 if (!NILP (subprefix_stack
[j
]))
1030 buf
.kind
= MENU_BAR_EVENT
;
1031 buf
.frame_or_window
= frame
;
1032 buf
.arg
= subprefix_stack
[j
];
1033 kbd_buffer_store_event (&buf
);
1038 buf
.kind
= MENU_BAR_EVENT
;
1039 buf
.frame_or_window
= frame
;
1041 kbd_buffer_store_event (&buf
);
1044 buf
.kind
= MENU_BAR_EVENT
;
1045 buf
.frame_or_window
= frame
;
1047 kbd_buffer_store_event (&buf
);
1049 f
->output_data
.mac
->menu_command_in_progress
= 0;
1050 f
->output_data
.mac
->menubar_active
= 0;
1053 i
+= MENU_ITEMS_ITEM_LENGTH
;
1056 f
->output_data
.mac
->menu_command_in_progress
= 0;
1057 f
->output_data
.mac
->menubar_active
= 0;
1060 /* Allocate a widget_value, blocking input. */
1063 xmalloc_widget_value ()
1065 widget_value
*value
;
1068 value
= malloc_widget_value ();
1074 /* This recursively calls free_widget_value on the tree of widgets.
1075 It must free all data that was malloc'ed for these widget_values.
1076 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1077 must be left alone. */
1080 free_menubar_widget_value_tree (wv
)
1085 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1087 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1089 free_menubar_widget_value_tree (wv
->contents
);
1090 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1094 free_menubar_widget_value_tree (wv
->next
);
1095 wv
->next
= (widget_value
*) 0xDEADBEEF;
1098 free_widget_value (wv
);
1102 /* Return a tree of widget_value structures for a menu bar item
1103 whose event type is ITEM_KEY (with string ITEM_NAME)
1104 and whose contents come from the list of keymaps MAPS. */
1106 static widget_value
*
1107 single_submenu (item_key
, item_name
, maps
)
1108 Lisp_Object item_key
, item_name
, maps
;
1110 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1112 int submenu_depth
= 0;
1115 Lisp_Object
*mapvec
;
1116 widget_value
**submenu_stack
;
1117 int previous_items
= menu_items_used
;
1118 int top_level_items
= 0;
1120 length
= Flength (maps
);
1121 len
= XINT (length
);
1123 /* Convert the list MAPS into a vector MAPVEC. */
1124 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1125 for (i
= 0; i
< len
; i
++)
1127 mapvec
[i
] = Fcar (maps
);
1131 menu_items_n_panes
= 0;
1133 /* Loop over the given keymaps, making a pane for each map.
1134 But don't make a pane that is empty--ignore that map instead. */
1135 for (i
= 0; i
< len
; i
++)
1137 if (SYMBOLP (mapvec
[i
])
1138 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1140 /* Here we have a command at top level in the menu bar
1141 as opposed to a submenu. */
1142 top_level_items
= 1;
1143 push_menu_pane (Qnil
, Qnil
);
1144 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1145 Qnil
, Qnil
, Qnil
, Qnil
);
1148 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1151 /* Create a tree of widget_value objects
1152 representing the panes and their items. */
1155 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1156 wv
= xmalloc_widget_value ();
1160 wv
->button_type
= BUTTON_TYPE_NONE
;
1166 /* Loop over all panes and items made during this call
1167 and construct a tree of widget_value objects.
1168 Ignore the panes and items made by previous calls to
1169 single_submenu, even though those are also in menu_items. */
1171 while (i
< menu_items_used
)
1173 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1175 submenu_stack
[submenu_depth
++] = save_wv
;
1180 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1183 save_wv
= submenu_stack
[--submenu_depth
];
1186 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1187 && submenu_depth
!= 0)
1188 i
+= MENU_ITEMS_PANE_LENGTH
;
1189 /* Ignore a nil in the item list.
1190 It's meaningful only for dialog boxes. */
1191 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1193 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1195 /* Create a new pane. */
1196 Lisp_Object pane_name
, prefix
;
1199 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1200 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1202 #ifndef HAVE_MULTILINGUAL_MENU
1203 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1205 pane_name
= ENCODE_SYSTEM (pane_name
);
1206 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1209 pane_string
= (NILP (pane_name
)
1210 ? "" : (char *) SDATA (pane_name
));
1211 /* If there is just one top-level pane, put all its items directly
1212 under the top-level menu. */
1213 if (menu_items_n_panes
== 1)
1216 /* If the pane has a meaningful name,
1217 make the pane a top-level menu item
1218 with its items as a submenu beneath it. */
1219 if (strcmp (pane_string
, ""))
1221 wv
= xmalloc_widget_value ();
1225 first_wv
->contents
= wv
;
1226 wv
->lname
= pane_name
;
1227 /* Set value to 1 so update_submenu_strings can handle '@' */
1228 wv
->value
= (char *)1;
1230 wv
->button_type
= BUTTON_TYPE_NONE
;
1235 i
+= MENU_ITEMS_PANE_LENGTH
;
1239 /* Create a new item within current pane. */
1240 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1243 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1244 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1245 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1246 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1247 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1248 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1249 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1251 #ifndef HAVE_MULTILINGUAL_MENU
1252 if (STRING_MULTIBYTE (item_name
))
1254 item_name
= ENCODE_MENU_STRING (item_name
);
1255 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1258 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1260 descrip
= ENCODE_MENU_STRING (descrip
);
1261 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1263 #endif /* not HAVE_MULTILINGUAL_MENU */
1265 wv
= xmalloc_widget_value ();
1269 save_wv
->contents
= wv
;
1271 wv
->lname
= item_name
;
1272 if (!NILP (descrip
))
1275 /* The EMACS_INT cast avoids a warning. There's no problem
1276 as long as pointers have enough bits to hold small integers. */
1277 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1278 wv
->enabled
= !NILP (enable
);
1281 wv
->button_type
= BUTTON_TYPE_NONE
;
1282 else if (EQ (type
, QCradio
))
1283 wv
->button_type
= BUTTON_TYPE_RADIO
;
1284 else if (EQ (type
, QCtoggle
))
1285 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1289 wv
->selected
= !NILP (selected
);
1290 if (!STRINGP (help
))
1297 i
+= MENU_ITEMS_ITEM_LENGTH
;
1301 /* If we have just one "menu item"
1302 that was originally a button, return it by itself. */
1303 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1305 wv
= first_wv
->contents
;
1306 free_widget_value (first_wv
);
1312 /* Walk through the widget_value tree starting at FIRST_WV and update
1313 the char * pointers from the corresponding lisp values.
1314 We do this after building the whole tree, since GC may happen while the
1315 tree is constructed, and small strings are relocated. So we must wait
1316 until no GC can happen before storing pointers into lisp values. */
1318 update_submenu_strings (first_wv
)
1319 widget_value
*first_wv
;
1323 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1325 if (STRINGP (wv
->lname
))
1327 wv
->name
= SDATA (wv
->lname
);
1329 /* Ignore the @ that means "separate pane".
1330 This is a kludge, but this isn't worth more time. */
1331 if (wv
->value
== (char *)1)
1333 if (wv
->name
[0] == '@')
1339 if (STRINGP (wv
->lkey
))
1340 wv
->key
= SDATA (wv
->lkey
);
1343 update_submenu_strings (wv
->contents
);
1348 /* Set the contents of the menubar widgets of frame F.
1349 The argument FIRST_TIME is currently ignored;
1350 it is set the first time this is called, from initialize_frame_menubar. */
1353 set_frame_menubar (f
, first_time
, deep_p
)
1358 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1360 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1363 /* We must not change the menubar when actually in use. */
1364 if (f
->output_data
.mac
->menubar_active
)
1367 XSETFRAME (Vmenu_updating_frame
, f
);
1369 if (! menubar_widget
)
1371 else if (pending_menu_activation
&& !deep_p
)
1374 wv
= xmalloc_widget_value ();
1375 wv
->name
= "menubar";
1378 wv
->button_type
= BUTTON_TYPE_NONE
;
1384 /* Make a widget-value tree representing the entire menu trees. */
1386 struct buffer
*prev
= current_buffer
;
1388 int specpdl_count
= SPECPDL_INDEX ();
1389 int previous_menu_items_used
= f
->menu_bar_items_used
;
1390 Lisp_Object
*previous_items
1391 = (Lisp_Object
*) alloca (previous_menu_items_used
1392 * sizeof (Lisp_Object
));
1394 /* If we are making a new widget, its contents are empty,
1395 do always reinitialize them. */
1396 if (! menubar_widget
)
1397 previous_menu_items_used
= 0;
1399 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1400 specbind (Qinhibit_quit
, Qt
);
1401 /* Don't let the debugger step into this code
1402 because it is not reentrant. */
1403 specbind (Qdebug_on_next_call
, Qnil
);
1405 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1406 if (NILP (Voverriding_local_map_menu_flag
))
1408 specbind (Qoverriding_terminal_local_map
, Qnil
);
1409 specbind (Qoverriding_local_map
, Qnil
);
1412 set_buffer_internal_1 (XBUFFER (buffer
));
1414 /* Run the Lucid hook. */
1415 safe_run_hooks (Qactivate_menubar_hook
);
1416 /* If it has changed current-menubar from previous value,
1417 really recompute the menubar from the value. */
1418 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1419 call0 (Qrecompute_lucid_menubar
);
1420 safe_run_hooks (Qmenu_bar_update_hook
);
1421 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1423 items
= FRAME_MENU_BAR_ITEMS (f
);
1425 /* Save the frame's previous menu bar contents data. */
1426 if (previous_menu_items_used
)
1427 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1428 previous_menu_items_used
* sizeof (Lisp_Object
));
1430 /* Fill in the current menu bar contents. */
1431 menu_items
= f
->menu_bar_vector
;
1432 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1434 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1436 Lisp_Object key
, string
, maps
;
1438 key
= XVECTOR (items
)->contents
[i
];
1439 string
= XVECTOR (items
)->contents
[i
+ 1];
1440 maps
= XVECTOR (items
)->contents
[i
+ 2];
1444 wv
= single_submenu (key
, string
, maps
);
1448 first_wv
->contents
= wv
;
1449 /* Don't set wv->name here; GC during the loop might relocate it. */
1451 wv
->button_type
= BUTTON_TYPE_NONE
;
1455 finish_menu_items ();
1457 set_buffer_internal_1 (prev
);
1458 unbind_to (specpdl_count
, Qnil
);
1460 /* If there has been no change in the Lisp-level contents
1461 of the menu bar, skip redisplaying it. Just exit. */
1463 for (i
= 0; i
< previous_menu_items_used
; i
++)
1464 if (menu_items_used
== i
1465 || (NILP (Fequal (previous_items
[i
],
1466 XVECTOR (menu_items
)->contents
[i
]))))
1468 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1470 free_menubar_widget_value_tree (first_wv
);
1476 /* Now GC cannot happen during the lifetime of the widget_value,
1477 so it's safe to store data from a Lisp_String, as long as
1478 local copies are made when the actual menu is created.
1479 Windows takes care of this for normal string items, but
1480 not for owner-drawn items or additional item-info. */
1481 wv
= first_wv
->contents
;
1482 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1485 string
= XVECTOR (items
)->contents
[i
+ 1];
1488 wv
->name
= (char *) SDATA (string
);
1489 update_submenu_strings (wv
->contents
);
1493 f
->menu_bar_vector
= menu_items
;
1494 f
->menu_bar_items_used
= menu_items_used
;
1499 /* Make a widget-value tree containing
1500 just the top level menu bar strings. */
1502 items
= FRAME_MENU_BAR_ITEMS (f
);
1503 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1507 string
= XVECTOR (items
)->contents
[i
+ 1];
1511 wv
= xmalloc_widget_value ();
1512 wv
->name
= (char *) SDATA (string
);
1515 wv
->button_type
= BUTTON_TYPE_NONE
;
1517 /* This prevents lwlib from assuming this
1518 menu item is really supposed to be empty. */
1519 /* The EMACS_INT cast avoids a warning.
1520 This value just has to be different from small integers. */
1521 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1526 first_wv
->contents
= wv
;
1530 /* Forget what we thought we knew about what is in the
1531 detailed contents of the menu bar menus.
1532 Changing the top level always destroys the contents. */
1533 f
->menu_bar_items_used
= 0;
1536 /* Create or update the menu bar widget. */
1540 /* Non-null value to indicate menubar has already been "created". */
1541 f
->output_data
.mac
->menubar_widget
= 1;
1544 int i
= MIN_MENU_ID
;
1545 MenuHandle menu
= GetMenuHandle (i
);
1546 while (menu
!= NULL
)
1550 menu
= GetMenuHandle (++i
);
1554 menu
= GetMenuHandle (i
);
1555 while (menu
!= NULL
)
1559 menu
= GetMenuHandle (++i
);
1563 fill_menubar (first_wv
->contents
);
1567 free_menubar_widget_value_tree (first_wv
);
1572 /* Called from Fx_create_frame to create the initial menubar of a frame
1573 before it is mapped, so that the window is mapped with the menubar already
1574 there instead of us tacking it on later and thrashing the window after it
1578 initialize_frame_menubar (f
)
1581 /* This function is called before the first chance to redisplay
1582 the frame. It has to be, so the frame will have the right size. */
1583 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1584 set_frame_menubar (f
, 1, 1);
1587 /* Get rid of the menu bar of frame F, and free its storage.
1588 This is used when deleting a frame, and when turning off the menu bar. */
1591 free_frame_menubar (f
)
1594 f
->output_data
.mac
->menubar_widget
= NULL
;
1598 /* mac_menu_show actually displays a menu using the panes and items in
1599 menu_items and returns the value selected from it; we assume input
1600 is blocked by the caller. */
1602 /* F is the frame the menu is for.
1603 X and Y are the frame-relative specified position,
1604 relative to the inside upper left corner of the frame F.
1605 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1606 KEYMAPS is 1 if this menu was specified with keymaps;
1607 in that case, we return a list containing the chosen item's value
1608 and perhaps also the pane's prefix.
1609 TITLE is the specified menu title.
1610 ERROR is a place to store an error message string in case of failure.
1611 (We return nil on failure, but the value doesn't actually matter.) */
1614 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1625 int menu_item_choice
;
1626 int menu_item_selection
;
1629 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1630 widget_value
**submenu_stack
1631 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1632 Lisp_Object
*subprefix_stack
1633 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1634 int submenu_depth
= 0;
1639 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1641 *error
= "Empty menu";
1645 /* Create a tree of widget_value objects
1646 representing the panes and their items. */
1647 wv
= xmalloc_widget_value ();
1651 wv
->button_type
= BUTTON_TYPE_NONE
;
1656 /* Loop over all panes and items, filling in the tree. */
1658 while (i
< menu_items_used
)
1660 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1662 submenu_stack
[submenu_depth
++] = save_wv
;
1668 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1671 save_wv
= submenu_stack
[--submenu_depth
];
1675 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1676 && submenu_depth
!= 0)
1677 i
+= MENU_ITEMS_PANE_LENGTH
;
1678 /* Ignore a nil in the item list.
1679 It's meaningful only for dialog boxes. */
1680 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1682 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1684 /* Create a new pane. */
1685 Lisp_Object pane_name
, prefix
;
1687 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1688 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1689 #ifndef HAVE_MULTILINGUAL_MENU
1690 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1692 pane_name
= ENCODE_SYSTEM (pane_name
);
1693 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1696 pane_string
= (NILP (pane_name
)
1697 ? "" : (char *) SDATA (pane_name
));
1698 /* If there is just one top-level pane, put all its items directly
1699 under the top-level menu. */
1700 if (menu_items_n_panes
== 1)
1703 /* If the pane has a meaningful name,
1704 make the pane a top-level menu item
1705 with its items as a submenu beneath it. */
1706 if (!keymaps
&& strcmp (pane_string
, ""))
1708 wv
= xmalloc_widget_value ();
1712 first_wv
->contents
= wv
;
1713 wv
->name
= pane_string
;
1714 if (keymaps
&& !NILP (prefix
))
1718 wv
->button_type
= BUTTON_TYPE_NONE
;
1723 else if (first_pane
)
1729 i
+= MENU_ITEMS_PANE_LENGTH
;
1733 /* Create a new item within current pane. */
1734 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1736 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1737 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1738 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1739 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1740 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1741 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1742 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1744 #ifndef HAVE_MULTILINGUAL_MENU
1745 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1747 item_name
= ENCODE_MENU_STRING (item_name
);
1748 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1750 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1752 descrip
= ENCODE_MENU_STRING (descrip
);
1753 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1755 #endif /* not HAVE_MULTILINGUAL_MENU */
1757 wv
= xmalloc_widget_value ();
1761 save_wv
->contents
= wv
;
1762 wv
->name
= (char *) SDATA (item_name
);
1763 if (!NILP (descrip
))
1764 wv
->key
= (char *) SDATA (descrip
);
1766 /* Use the contents index as call_data, since we are
1767 restricted to 16-bits. */
1768 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1769 wv
->enabled
= !NILP (enable
);
1772 wv
->button_type
= BUTTON_TYPE_NONE
;
1773 else if (EQ (type
, QCtoggle
))
1774 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1775 else if (EQ (type
, QCradio
))
1776 wv
->button_type
= BUTTON_TYPE_RADIO
;
1780 wv
->selected
= !NILP (selected
);
1781 if (!STRINGP (help
))
1788 i
+= MENU_ITEMS_ITEM_LENGTH
;
1792 /* Deal with the title, if it is non-nil. */
1795 widget_value
*wv_title
= xmalloc_widget_value ();
1796 widget_value
*wv_sep
= xmalloc_widget_value ();
1798 /* Maybe replace this separator with a bitmap or owner-draw item
1799 so that it looks better. Having two separators looks odd. */
1800 wv_sep
->name
= "--";
1801 wv_sep
->next
= first_wv
->contents
;
1802 wv_sep
->help
= Qnil
;
1804 #ifndef HAVE_MULTILINGUAL_MENU
1805 if (STRING_MULTIBYTE (title
))
1806 title
= ENCODE_MENU_STRING (title
);
1808 wv_title
->name
= (char *) SDATA (title
);
1809 wv_title
->enabled
= TRUE
;
1810 wv_title
->title
= TRUE
;
1811 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1812 wv_title
->help
= Qnil
;
1813 wv_title
->next
= wv_sep
;
1814 first_wv
->contents
= wv_title
;
1817 /* Actually create the menu. */
1818 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1819 submenu_id
= MIN_POPUP_SUBMENU_ID
;
1820 fill_submenu (menu
, first_wv
->contents
);
1822 /* Adjust coordinates to be root-window-relative. */
1826 SetPortWindowPort (FRAME_MAC_WINDOW (f
));
1828 LocalToGlobal (&pos
);
1830 /* No selection has been chosen yet. */
1831 menu_item_choice
= 0;
1832 menu_item_selection
= 0;
1834 InsertMenu (menu
, -1);
1836 /* Display the menu. */
1837 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
1838 menu_item_selection
= LoWord (menu_item_choice
);
1840 /* Get the refcon to find the correct item*/
1841 if (menu_item_selection
)
1843 MenuHandle sel_menu
= GetMenuHandle (HiWord (menu_item_choice
));
1845 GetMenuItemRefCon (sel_menu
, menu_item_selection
, &refcon
);
1850 /* Clean up extraneous mouse events which might have been generated
1852 discard_mouse_events ();
1855 /* Must reset this manually because the button release event is not
1856 passed to Emacs event loop. */
1857 FRAME_MAC_DISPLAY_INFO (f
)->grabbed
= 0;
1859 /* Free the widget_value objects we used to specify the
1861 free_menubar_widget_value_tree (first_wv
);
1863 /* delete all menus */
1865 int i
= MIN_POPUP_SUBMENU_ID
;
1866 MenuHandle submenu
= GetMenuHandle (i
);
1867 while (submenu
!= NULL
)
1870 DisposeMenu (submenu
);
1871 submenu
= GetMenuHandle (++i
);
1875 DeleteMenu (POPUP_SUBMENU_ID
);
1878 /* Find the selected item, and its pane, to return
1879 the proper value. */
1880 if (menu_item_selection
!= 0)
1882 Lisp_Object prefix
, entry
;
1884 prefix
= entry
= Qnil
;
1886 while (i
< menu_items_used
)
1888 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1890 subprefix_stack
[submenu_depth
++] = prefix
;
1894 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1896 prefix
= subprefix_stack
[--submenu_depth
];
1899 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1902 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1903 i
+= MENU_ITEMS_PANE_LENGTH
;
1905 /* Ignore a nil in the item list.
1906 It's meaningful only for dialog boxes. */
1907 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1912 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1913 if ((int) (EMACS_INT
) refcon
== i
)
1919 entry
= Fcons (entry
, Qnil
);
1921 entry
= Fcons (prefix
, entry
);
1922 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1923 if (!NILP (subprefix_stack
[j
]))
1924 entry
= Fcons (subprefix_stack
[j
], entry
);
1928 i
+= MENU_ITEMS_ITEM_LENGTH
;
1938 /* Construct native Mac OS menubar based on widget_value tree. */
1941 mac_dialog (widget_value
*wv
)
1945 char **button_labels
;
1952 WindowPtr window_ptr
;
1955 EventRecord event_record
;
1957 int control_part_code
;
1960 dialog_name
= wv
->name
;
1961 nb_buttons
= dialog_name
[1] - '0';
1962 left_count
= nb_buttons
- (dialog_name
[4] - '0');
1963 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
1964 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
1967 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
1968 strcpy (prompt
, wv
->value
);
1972 for (i
= 0; i
< nb_buttons
; i
++)
1974 button_labels
[i
] = wv
->value
;
1975 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
1976 strcpy (button_labels
[i
], wv
->value
);
1977 c2pstr (button_labels
[i
]);
1978 ref_cons
[i
] = (UInt32
) wv
->call_data
;
1982 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
1984 SetPortWindowPort (window_ptr
);
1987 /* Left and right margins in the dialog are 13 pixels each.*/
1989 /* Calculate width of dialog box: 8 pixels on each side of the text
1990 label in each button, 12 pixels between buttons. */
1991 for (i
= 0; i
< nb_buttons
; i
++)
1992 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1994 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1997 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
1999 SizeWindow (window_ptr
, dialog_width
, 78, 0);
2000 ShowWindow (window_ptr
);
2002 SetPortWindowPort (window_ptr
);
2007 DrawString (prompt
);
2010 for (i
= 0; i
< nb_buttons
; i
++)
2012 int button_width
= StringWidth (button_labels
[i
]) + 16;
2013 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
2014 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
2015 kControlPushButtonProc
, ref_cons
[i
]);
2016 left
+= button_width
+ 12;
2017 if (i
== left_count
- 1)
2024 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
2025 if (event_record
.what
== mouseDown
)
2027 part_code
= FindWindow (event_record
.where
, &window_ptr
);
2028 if (part_code
== inContent
)
2030 mouse
= event_record
.where
;
2031 GlobalToLocal (&mouse
);
2032 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2033 if (control_part_code
== kControlButtonPart
)
2034 if (TrackControl (ch
, mouse
, NULL
))
2035 i
= GetControlReference (ch
);
2040 DisposeWindow (window_ptr
);
2045 static char * button_names
[] = {
2046 "button1", "button2", "button3", "button4", "button5",
2047 "button6", "button7", "button8", "button9", "button10" };
2050 mac_dialog_show (f
, keymaps
, title
, error
)
2056 int i
, nb_buttons
=0;
2057 char dialog_name
[6];
2058 int menu_item_selection
;
2060 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2062 /* Number of elements seen so far, before boundary. */
2064 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2065 int boundary_seen
= 0;
2069 if (menu_items_n_panes
> 1)
2071 *error
= "Multiple panes in dialog box";
2075 /* Create a tree of widget_value objects
2076 representing the text label and buttons. */
2078 Lisp_Object pane_name
, prefix
;
2080 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2081 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2082 pane_string
= (NILP (pane_name
)
2083 ? "" : (char *) SDATA (pane_name
));
2084 prev_wv
= xmalloc_widget_value ();
2085 prev_wv
->value
= pane_string
;
2086 if (keymaps
&& !NILP (prefix
))
2088 prev_wv
->enabled
= 1;
2089 prev_wv
->name
= "message";
2090 prev_wv
->help
= Qnil
;
2093 /* Loop over all panes and items, filling in the tree. */
2094 i
= MENU_ITEMS_PANE_LENGTH
;
2095 while (i
< menu_items_used
)
2098 /* Create a new item within current pane. */
2099 Lisp_Object item_name
, enable
, descrip
, help
;
2101 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2102 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2104 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2105 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2107 if (NILP (item_name
))
2109 free_menubar_widget_value_tree (first_wv
);
2110 *error
= "Submenu in dialog items";
2113 if (EQ (item_name
, Qquote
))
2115 /* This is the boundary between left-side elts
2116 and right-side elts. Stop incrementing right_count. */
2121 if (nb_buttons
>= 9)
2123 free_menubar_widget_value_tree (first_wv
);
2124 *error
= "Too many dialog items";
2128 wv
= xmalloc_widget_value ();
2130 wv
->name
= (char *) button_names
[nb_buttons
];
2131 if (!NILP (descrip
))
2132 wv
->key
= (char *) SDATA (descrip
);
2133 wv
->value
= (char *) SDATA (item_name
);
2134 wv
->call_data
= (void *) i
;
2135 /* menu item is identified by its index in menu_items table */
2136 wv
->enabled
= !NILP (enable
);
2140 if (! boundary_seen
)
2144 i
+= MENU_ITEMS_ITEM_LENGTH
;
2147 /* If the boundary was not specified,
2148 by default put half on the left and half on the right. */
2149 if (! boundary_seen
)
2150 left_count
= nb_buttons
- nb_buttons
/ 2;
2152 wv
= xmalloc_widget_value ();
2153 wv
->name
= dialog_name
;
2156 /* Dialog boxes use a really stupid name encoding
2157 which specifies how many buttons to use
2158 and how many buttons are on the right.
2159 The Q means something also. */
2160 dialog_name
[0] = 'Q';
2161 dialog_name
[1] = '0' + nb_buttons
;
2162 dialog_name
[2] = 'B';
2163 dialog_name
[3] = 'R';
2164 /* Number of buttons to put on the right. */
2165 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2167 wv
->contents
= first_wv
;
2171 /* Actually create the dialog. */
2173 menu_item_selection
= mac_dialog (first_wv
);
2175 menu_item_selection
= 0;
2178 /* Free the widget_value objects we used to specify the contents. */
2179 free_menubar_widget_value_tree (first_wv
);
2181 /* Find the selected item, and its pane, to return the proper
2183 if (menu_item_selection
!= 0)
2189 while (i
< menu_items_used
)
2193 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2196 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2197 i
+= MENU_ITEMS_PANE_LENGTH
;
2202 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2203 if (menu_item_selection
== i
)
2207 entry
= Fcons (entry
, Qnil
);
2209 entry
= Fcons (prefix
, entry
);
2213 i
+= MENU_ITEMS_ITEM_LENGTH
;
2220 #endif /* HAVE_DIALOGS */
2223 /* Is this item a separator? */
2225 name_is_separator (name
)
2230 /* Check if name string consists of only dashes ('-'). */
2231 while (*name
== '-') name
++;
2232 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2233 or "--deep-shadow". We don't implement them yet, se we just treat
2234 them like normal separators. */
2235 return (*name
== '\0' || start
+ 2 == name
);
2239 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
,
2245 if (name_is_separator (wv
->name
))
2246 AppendMenu (menu
, "\p-");
2249 AppendMenu (menu
, "\pX");
2251 #if TARGET_API_MAC_CARBON
2252 pos
= CountMenuItems (menu
);
2254 pos
= CountMItems (menu
);
2257 strcpy (item_name
, "");
2258 strncat (item_name
, wv
->name
, 255);
2259 if (wv
->key
!= NULL
)
2261 strncat (item_name
, " ", 255);
2262 strncat (item_name
, wv
->key
, 255);
2265 #if TARGET_API_MAC_CARBON
2267 CFStringRef string
=
2268 CFStringCreateWithCString (NULL
, item_name
, kCFStringEncodingUTF8
);
2270 SetMenuItemTextWithCFString (menu
, pos
, string
);
2275 SetMenuItemText (menu
, pos
, item_name
);
2278 if (wv
->enabled
&& !force_disable
)
2279 #if TARGET_API_MAC_CARBON
2280 EnableMenuItem (menu
, pos
);
2282 EnableItem (menu
, pos
);
2285 #if TARGET_API_MAC_CARBON
2286 DisableMenuItem (menu
, pos
);
2288 DisableItem (menu
, pos
);
2291 /* Draw radio buttons and tickboxes. */
2293 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2294 wv
->button_type
== BUTTON_TYPE_RADIO
))
2295 SetItemMark (menu
, pos
, checkMark
);
2297 SetItemMark (menu
, pos
, noMark
);
2300 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2303 if (submenu
!= NULL
)
2304 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2307 /* Construct native Mac OS menubar based on widget_value tree. */
2310 fill_submenu (MenuHandle menu
, widget_value
*wv
)
2312 for ( ; wv
!= NULL
; wv
= wv
->next
)
2315 int cur_submenu
= submenu_id
++;
2316 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2317 fill_submenu (submenu
, wv
->contents
);
2318 InsertMenu (submenu
, -1);
2319 add_menu_item (menu
, wv
, cur_submenu
, 0);
2322 add_menu_item (menu
, wv
, NULL
, 0);
2326 /* Construct native Mac OS menu based on widget_value tree. */
2329 fill_menu (MenuHandle menu
, widget_value
*wv
)
2331 for ( ; wv
!= NULL
; wv
= wv
->next
)
2334 int cur_submenu
= submenu_id
++;
2335 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2336 fill_submenu (submenu
, wv
->contents
);
2337 InsertMenu (submenu
, -1);
2338 add_menu_item (menu
, wv
, cur_submenu
, 0);
2341 add_menu_item (menu
, wv
, NULL
, 0);
2344 /* Construct native Mac OS menubar based on widget_value tree. */
2347 fill_menubar (widget_value
*wv
)
2351 submenu_id
= MIN_SUBMENU_ID
;
2353 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2358 strncpy (title
, wv
->name
, 255);
2361 menu
= NewMenu (id
, title
);
2364 fill_menu (menu
, wv
->contents
);
2366 InsertMenu (menu
, 0);
2370 #endif /* HAVE_MENUS */
2376 staticpro (&menu_items
);
2379 Qdebug_on_next_call
= intern ("debug-on-next-call");
2380 staticpro (&Qdebug_on_next_call
);
2382 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2383 doc
: /* Frame for which we are updating a menu.
2384 The enable predicate for a menu command should check this variable. */);
2385 Vmenu_updating_frame
= Qnil
;
2387 defsubr (&Sx_popup_menu
);
2389 defsubr (&Sx_popup_dialog
);
2393 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2394 (do not change this comment) */