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
94 /* value (meaning depend on widget type) */
96 /* keyboard equivalent. no implications for XtTranslations */
98 /* Help string or nil if none.
99 GC finds this string through the frame's menu_bar_vector
100 or through menu_items. */
102 /* true if enabled */
104 /* true if selected */
106 /* The type of a button. */
107 enum button_type button_type
;
108 /* true if menu title */
111 /* true if was edited (maintained by get_value) */
113 /* true if has changed (maintained by lw library) */
115 /* true if this widget itself has changed,
116 but not counting the other widgets found in the `next' field. */
117 change_type this_one_change
;
119 /* Contents of the sub-widgets, also selected slot for checkbox */
120 struct _widget_value
* contents
;
121 /* data passed to callback */
123 /* next one in the list */
124 struct _widget_value
* next
;
126 /* slot for the toolkit dependent part. Always initialize to NULL. */
128 /* tell us if we should free the toolkit data slot when freeing the
129 widget_value itself. */
130 Boolean free_toolkit_data
;
132 /* we resource the widget_value structures; this points to the next
133 one on the free list if this one has been deallocated.
135 struct _widget_value
*free_list
;
139 /* Assumed by other routines to zero area returned. */
140 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
141 0, (sizeof (widget_value)))
142 #define free_widget_value(wv) xfree (wv)
144 /******************************************************************/
151 Lisp_Object Vmenu_updating_frame
;
153 Lisp_Object Qdebug_on_next_call
;
155 extern Lisp_Object Qmenu_bar
;
157 extern Lisp_Object QCtoggle
, QCradio
;
159 extern Lisp_Object Voverriding_local_map
;
160 extern Lisp_Object Voverriding_local_map_menu_flag
;
162 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
164 extern Lisp_Object Qmenu_bar_update_hook
;
166 void set_frame_menubar ();
168 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
169 Lisp_Object
, Lisp_Object
, Lisp_Object
,
170 Lisp_Object
, Lisp_Object
));
172 static Lisp_Object
mac_dialog_show ();
174 static Lisp_Object
mac_menu_show ();
176 static void keymap_panes ();
177 static void single_keymap_panes ();
178 static void single_menu_item ();
179 static void list_of_panes ();
180 static void list_of_items ();
182 static void fill_submenu (MenuHandle
, widget_value
*);
183 static void fill_menubar (widget_value
*);
186 /* This holds a Lisp vector that holds the results of decoding
187 the keymaps or alist-of-alists that specify a menu.
189 It describes the panes and items within the panes.
191 Each pane is described by 3 elements in the vector:
192 t, the pane name, the pane's prefix key.
193 Then follow the pane's items, with 5 elements per item:
194 the item string, the enable flag, the item's value,
195 the definition, and the equivalent keyboard key's description string.
197 In some cases, multiple levels of menus may be described.
198 A single vector slot containing nil indicates the start of a submenu.
199 A single vector slot containing lambda indicates the end of a submenu.
200 The submenu follows a menu item which is the way to reach the submenu.
202 A single vector slot containing quote indicates that the
203 following items should appear on the right of a dialog box.
205 Using a Lisp vector to hold this information while we decode it
206 takes care of protecting all the data from GC. */
208 #define MENU_ITEMS_PANE_NAME 1
209 #define MENU_ITEMS_PANE_PREFIX 2
210 #define MENU_ITEMS_PANE_LENGTH 3
214 MENU_ITEMS_ITEM_NAME
= 0,
215 MENU_ITEMS_ITEM_ENABLE
,
216 MENU_ITEMS_ITEM_VALUE
,
217 MENU_ITEMS_ITEM_EQUIV_KEY
,
218 MENU_ITEMS_ITEM_DEFINITION
,
219 MENU_ITEMS_ITEM_TYPE
,
220 MENU_ITEMS_ITEM_SELECTED
,
221 MENU_ITEMS_ITEM_HELP
,
222 MENU_ITEMS_ITEM_LENGTH
225 static Lisp_Object menu_items
;
227 /* Number of slots currently allocated in menu_items. */
228 static int menu_items_allocated
;
230 /* This is the index in menu_items of the first empty slot. */
231 static int menu_items_used
;
233 /* The number of panes currently recorded in menu_items,
234 excluding those within submenus. */
235 static int menu_items_n_panes
;
237 /* Current depth within submenus. */
238 static int menu_items_submenu_depth
;
240 /* Flag which when set indicates a dialog or menu has been posted by
241 Xt on behalf of one of the widget sets. */
242 static int popup_activated_flag
;
244 /* Index of the next submenu */
245 static int submenu_id
;
247 static int next_menubar_widget_id
;
249 /* This is set nonzero after the user activates the menu bar, and set
250 to zero again after the menu bars are redisplayed by prepare_menu_bar.
251 While it is nonzero, all calls to set_frame_menubar go deep.
253 I don't understand why this is needed, but it does seem to be
254 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
256 int pending_menu_activation
;
258 /* Initialize the menu_items structure if we haven't already done so.
259 Also mark it as currently empty. */
264 if (NILP (menu_items
))
266 menu_items_allocated
= 60;
267 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
271 menu_items_n_panes
= 0;
272 menu_items_submenu_depth
= 0;
275 /* Call at the end of generating the data in menu_items.
276 This fills in the number of items in the last pane. */
283 /* Call when finished using the data for the current menu
287 discard_menu_items ()
289 /* Free the structure if it is especially large.
290 Otherwise, hold on to it, to save time. */
291 if (menu_items_allocated
> 200)
294 menu_items_allocated
= 0;
298 /* Make the menu_items vector twice as large. */
304 int old_size
= menu_items_allocated
;
307 menu_items_allocated
*= 2;
308 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
309 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
310 old_size
* sizeof (Lisp_Object
));
313 /* Begin a submenu. */
316 push_submenu_start ()
318 if (menu_items_used
+ 1 > menu_items_allocated
)
321 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
322 menu_items_submenu_depth
++;
330 if (menu_items_used
+ 1 > menu_items_allocated
)
333 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
334 menu_items_submenu_depth
--;
337 /* Indicate boundary between left and right. */
340 push_left_right_boundary ()
342 if (menu_items_used
+ 1 > menu_items_allocated
)
345 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
348 /* Start a new menu pane in menu_items.
349 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
352 push_menu_pane (name
, prefix_vec
)
353 Lisp_Object name
, prefix_vec
;
355 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
358 if (menu_items_submenu_depth
== 0)
359 menu_items_n_panes
++;
360 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
361 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
362 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
365 /* Push one menu item into the current pane. NAME is the string to
366 display. ENABLE if non-nil means this item can be selected. KEY
367 is the key generated by choosing this item, or nil if this item
368 doesn't really have a definition. DEF is the definition of this
369 item. EQUIV is the textual description of the keyboard equivalent
370 for this item (or nil if none). TYPE is the type of this menu
371 item, one of nil, `toggle' or `radio'. */
374 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
375 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
377 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
380 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
381 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
382 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
383 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
384 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
385 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
386 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
387 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
390 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
391 and generate menu panes for them in menu_items.
392 If NOTREAL is nonzero,
393 don't bother really computing whether an item is enabled. */
396 keymap_panes (keymaps
, nmaps
, notreal
)
397 Lisp_Object
*keymaps
;
405 /* Loop over the given keymaps, making a pane for each map.
406 But don't make a pane that is empty--ignore that map instead.
407 P is the number of panes we have made so far. */
408 for (mapno
= 0; mapno
< nmaps
; mapno
++)
409 single_keymap_panes (keymaps
[mapno
],
410 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
412 finish_menu_items ();
415 /* This is a recursive subroutine of keymap_panes.
416 It handles one keymap, KEYMAP.
417 The other arguments are passed along
418 or point to local variables of the previous function.
419 If NOTREAL is nonzero, only check for equivalent key bindings, don't
420 evaluate expressions in menu items and don't make any menu.
422 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
425 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
427 Lisp_Object pane_name
;
432 Lisp_Object pending_maps
= Qnil
;
433 Lisp_Object tail
, item
;
434 struct gcpro gcpro1
, gcpro2
;
439 push_menu_pane (pane_name
, prefix
);
441 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
443 GCPRO2 (keymap
, pending_maps
);
444 /* Look at each key binding, and if it is a menu item add it
448 single_menu_item (XCAR (item
), XCDR (item
),
449 &pending_maps
, notreal
, maxdepth
);
450 else if (VECTORP (item
))
452 /* Loop over the char values represented in the vector. */
453 int len
= XVECTOR (item
)->size
;
455 for (c
= 0; c
< len
; c
++)
457 Lisp_Object character
;
458 XSETFASTINT (character
, c
);
459 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
460 &pending_maps
, notreal
, maxdepth
);
466 /* Process now any submenus which want to be panes at this level. */
467 while (!NILP (pending_maps
))
469 Lisp_Object elt
, eltcdr
, string
;
470 elt
= Fcar (pending_maps
);
472 string
= XCAR (eltcdr
);
473 /* We no longer discard the @ from the beginning of the string here.
474 Instead, we do this in mac_menu_show. */
475 single_keymap_panes (Fcar (elt
), string
,
476 XCDR (eltcdr
), notreal
, maxdepth
- 1);
477 pending_maps
= Fcdr (pending_maps
);
481 /* This is a subroutine of single_keymap_panes that handles one
483 KEY is a key in a keymap and ITEM is its binding.
484 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
486 If NOTREAL is nonzero, only check for equivalent key bindings, don't
487 evaluate expressions in menu items and don't make any menu.
488 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
491 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
492 Lisp_Object key
, item
;
493 Lisp_Object
*pending_maps_ptr
;
494 int maxdepth
, notreal
;
496 Lisp_Object map
, item_string
, enabled
;
497 struct gcpro gcpro1
, gcpro2
;
500 /* Parse the menu item and leave the result in item_properties. */
502 res
= parse_menu_item (item
, notreal
, 0);
505 return; /* Not a menu item. */
507 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
511 /* We don't want to make a menu, just traverse the keymaps to
512 precompute equivalent key bindings. */
514 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
518 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
519 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
521 if (!NILP (map
) && SREF (item_string
, 0) == '@')
524 /* An enabled separate pane. Remember this to handle it later. */
525 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
530 push_menu_item (item_string
, enabled
, key
,
531 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
532 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
533 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
534 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
535 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
537 /* Display a submenu using the toolkit. */
538 if (! (NILP (map
) || NILP (enabled
)))
540 push_submenu_start ();
541 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
546 /* Push all the panes and items of a menu described by the
547 alist-of-alists MENU.
548 This handles old-fashioned calls to x-popup-menu. */
558 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
560 Lisp_Object elt
, pane_name
, pane_data
;
562 pane_name
= Fcar (elt
);
563 CHECK_STRING (pane_name
);
564 push_menu_pane (pane_name
, Qnil
);
565 pane_data
= Fcdr (elt
);
566 CHECK_CONS (pane_data
);
567 list_of_items (pane_data
);
570 finish_menu_items ();
573 /* Push the items in a single pane defined by the alist PANE. */
579 Lisp_Object tail
, item
, item1
;
581 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
585 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
586 else if (NILP (item
))
587 push_left_right_boundary ();
592 CHECK_STRING (item1
);
593 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
598 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
599 doc
: /* Pop up a deck-of-cards menu and return user's selection.
600 POSITION is a position specification. This is either a mouse button
601 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
602 are positions in pixels from the top left corner of WINDOW's frame
603 \(WINDOW may be a frame object instead of a window). This controls the
604 position of the center of the first line in the first pane of the
605 menu, not the top left of the menu as a whole. If POSITION is t, it
606 means to use the current mouse position.
608 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
609 The menu items come from key bindings that have a menu string as well as
610 a definition; actually, the \"definition\" in such a key binding looks like
611 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
612 the keymap as a top-level element.
614 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
615 Otherwise, REAL-DEFINITION should be a valid key binding definition.
617 You can also use a list of keymaps as MENU. Then each keymap makes a
618 separate pane. When MENU is a keymap or a list of keymaps, the return
619 value is a list of events.
621 Alternatively, you can specify a menu of multiple panes with a list of
622 the form (TITLE PANE1 PANE2...), where each pane is a list of
623 form (TITLE ITEM1 ITEM2...).
624 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
625 appear as an item--that makes a nonselectable line in the menu.
626 With this form of menu, the return value is VALUE from the chosen item.
628 If POSITION is nil, don't display the menu at all, just precalculate the
629 cached information about equivalent key sequences. */)
631 Lisp_Object position
, menu
;
633 Lisp_Object keymap
, tem
;
634 int xpos
= 0, ypos
= 0;
637 Lisp_Object selection
;
639 Lisp_Object x
, y
, window
;
645 if (! NILP (position
))
649 /* Decode the first argument: find the window and the coordinates. */
650 if (EQ (position
, Qt
)
651 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
652 || EQ (XCAR (position
), Qtool_bar
))))
654 /* Use the mouse's current position. */
655 FRAME_PTR new_f
= SELECTED_FRAME ();
656 Lisp_Object bar_window
;
657 enum scroll_bar_part part
;
660 if (mouse_position_hook
)
661 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
662 &part
, &x
, &y
, &time
);
664 XSETFRAME (window
, new_f
);
667 window
= selected_window
;
674 tem
= Fcar (position
);
677 window
= Fcar (Fcdr (position
));
679 y
= Fcar (Fcdr (tem
));
684 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
685 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
686 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
695 /* Decode where to put the menu. */
703 else if (WINDOWP (window
))
705 CHECK_LIVE_WINDOW (window
);
706 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
708 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
709 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
712 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
713 but I don't want to make one now. */
714 CHECK_WINDOW (window
);
719 XSETFRAME (Vmenu_updating_frame
, f
);
721 Vmenu_updating_frame
= Qnil
;
722 #endif /* HAVE_MENUS */
727 /* Decode the menu items from what was specified. */
729 keymap
= get_keymap (menu
, 0, 0);
732 /* We were given a keymap. Extract menu info from the keymap. */
735 /* Extract the detailed info to make one pane. */
736 keymap_panes (&menu
, 1, NILP (position
));
738 /* Search for a string appearing directly as an element of the keymap.
739 That string is the title of the menu. */
740 prompt
= Fkeymap_prompt (keymap
);
741 if (NILP (title
) && !NILP (prompt
))
744 /* Make that be the pane title of the first pane. */
745 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
746 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
750 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
752 /* We were given a list of keymaps. */
753 int nmaps
= XFASTINT (Flength (menu
));
755 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
760 /* The first keymap that has a prompt string
761 supplies the menu title. */
762 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
766 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
768 prompt
= Fkeymap_prompt (keymap
);
769 if (NILP (title
) && !NILP (prompt
))
773 /* Extract the detailed info to make one pane. */
774 keymap_panes (maps
, nmaps
, NILP (position
));
776 /* Make the title be the pane title of the first pane. */
777 if (!NILP (title
) && menu_items_n_panes
>= 0)
778 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
784 /* We were given an old-fashioned menu. */
786 CHECK_STRING (title
);
788 list_of_panes (Fcdr (menu
));
795 discard_menu_items ();
801 /* Display them in a menu. */
804 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
805 keymaps
, title
, &error_name
);
808 discard_menu_items ();
811 #endif /* HAVE_MENUS */
813 if (error_name
) error (error_name
);
819 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
820 doc
: /* Pop up a dialog box and return user's selection.
821 POSITION specifies which frame to use.
822 This is normally a mouse button event or a window or frame.
823 If POSITION is t, it means to use the frame the mouse is on.
824 The dialog box appears in the middle of the specified frame.
826 CONTENTS specifies the alternatives to display in the dialog box.
827 It is a list of the form (TITLE ITEM1 ITEM2...).
828 Each ITEM is a cons cell (STRING . VALUE).
829 The return value is VALUE from the chosen item.
831 An ITEM may also be just a string--that makes a nonselectable item.
832 An ITEM may also be nil--that means to put all preceding items
833 on the left of the dialog box and all following items on the right.
834 \(By default, approximately half appear on each side.) */)
836 Lisp_Object position
, contents
;
843 /* Decode the first argument: find the window or frame to use. */
844 if (EQ (position
, Qt
)
845 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
846 || EQ (XCAR (position
), Qtool_bar
))))
848 #if 0 /* Using the frame the mouse is on may not be right. */
849 /* Use the mouse's current position. */
850 FRAME_PTR new_f
= SELECTED_FRAME ();
851 Lisp_Object bar_window
;
852 enum scroll_bar_part part
;
856 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
859 XSETFRAME (window
, new_f
);
861 window
= selected_window
;
863 window
= selected_window
;
865 else if (CONSP (position
))
868 tem
= Fcar (position
);
870 window
= Fcar (Fcdr (position
));
873 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
874 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
877 else if (WINDOWP (position
) || FRAMEP (position
))
882 /* Decode where to put the menu. */
886 else if (WINDOWP (window
))
888 CHECK_LIVE_WINDOW (window
);
889 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
892 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
893 but I don't want to make one now. */
894 CHECK_WINDOW (window
);
897 /* Display a menu with these alternatives
898 in the middle of frame F. */
900 Lisp_Object x
, y
, frame
, newpos
;
901 XSETFRAME (frame
, f
);
902 XSETINT (x
, x_pixel_width (f
) / 2);
903 XSETINT (y
, x_pixel_height (f
) / 2);
904 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
906 return Fx_popup_menu (newpos
,
907 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
909 #else /* HAVE_DIALOGS */
913 Lisp_Object selection
;
915 /* Decode the dialog items from what was specified. */
916 title
= Fcar (contents
);
917 CHECK_STRING (title
);
919 list_of_panes (Fcons (contents
, Qnil
));
921 /* Display them in a dialog box. */
923 selection
= mac_dialog_show (f
, 0, title
, &error_name
);
926 discard_menu_items ();
928 if (error_name
) error (error_name
);
931 #endif /* HAVE_DIALOGS */
934 /* Activate the menu bar of frame F.
935 This is called from keyboard.c when it gets the
936 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
938 To activate the menu bar, we signal to the input thread that it can
939 return from the WM_INITMENU message, allowing the normal Windows
940 processing of the menus.
942 But first we recompute the menu bar contents (the whole tree).
944 This way we can safely execute Lisp code. */
947 x_activate_menubar (f
)
951 extern Point saved_menu_event_location
;
953 set_frame_menubar (f
, 0, 1);
956 menu_choice
= MenuSelect (saved_menu_event_location
);
957 do_menu_choice (menu_choice
);
962 /* This callback is called from the menu bar pulldown menu
963 when the user makes a selection.
964 Figure out what the user chose
965 and put the appropriate events into the keyboard buffer. */
968 menubar_selection_callback (FRAME_PTR f
, int client_data
)
970 Lisp_Object prefix
, entry
;
972 Lisp_Object
*subprefix_stack
;
973 int submenu_depth
= 0;
979 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
980 vector
= f
->menu_bar_vector
;
983 while (i
< f
->menu_bar_items_used
)
985 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
987 subprefix_stack
[submenu_depth
++] = prefix
;
991 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
993 prefix
= subprefix_stack
[--submenu_depth
];
996 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
998 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
999 i
+= MENU_ITEMS_PANE_LENGTH
;
1003 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1004 /* The EMACS_INT cast avoids a warning. There's no problem
1005 as long as pointers have enough bits to hold small integers. */
1006 if ((int) (EMACS_INT
) client_data
== i
)
1009 struct input_event buf
;
1013 XSETFRAME (frame
, f
);
1014 buf
.kind
= MENU_BAR_EVENT
;
1015 buf
.frame_or_window
= frame
;
1017 kbd_buffer_store_event (&buf
);
1019 for (j
= 0; j
< submenu_depth
; j
++)
1020 if (!NILP (subprefix_stack
[j
]))
1022 buf
.kind
= MENU_BAR_EVENT
;
1023 buf
.frame_or_window
= frame
;
1024 buf
.arg
= subprefix_stack
[j
];
1025 kbd_buffer_store_event (&buf
);
1030 buf
.kind
= MENU_BAR_EVENT
;
1031 buf
.frame_or_window
= frame
;
1033 kbd_buffer_store_event (&buf
);
1036 buf
.kind
= MENU_BAR_EVENT
;
1037 buf
.frame_or_window
= frame
;
1039 kbd_buffer_store_event (&buf
);
1041 f
->output_data
.mac
->menu_command_in_progress
= 0;
1042 f
->output_data
.mac
->menubar_active
= 0;
1045 i
+= MENU_ITEMS_ITEM_LENGTH
;
1048 f
->output_data
.mac
->menu_command_in_progress
= 0;
1049 f
->output_data
.mac
->menubar_active
= 0;
1052 /* Allocate a widget_value, blocking input. */
1055 xmalloc_widget_value ()
1057 widget_value
*value
;
1060 value
= malloc_widget_value ();
1066 /* This recursively calls free_widget_value on the tree of widgets.
1067 It must free all data that was malloc'ed for these widget_values.
1068 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1069 must be left alone. */
1072 free_menubar_widget_value_tree (wv
)
1077 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1079 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1081 free_menubar_widget_value_tree (wv
->contents
);
1082 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1086 free_menubar_widget_value_tree (wv
->next
);
1087 wv
->next
= (widget_value
*) 0xDEADBEEF;
1090 free_widget_value (wv
);
1094 /* Return a tree of widget_value structures for a menu bar item
1095 whose event type is ITEM_KEY (with string ITEM_NAME)
1096 and whose contents come from the list of keymaps MAPS. */
1098 static widget_value
*
1099 single_submenu (item_key
, item_name
, maps
)
1100 Lisp_Object item_key
, item_name
, maps
;
1102 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1104 int submenu_depth
= 0;
1107 Lisp_Object
*mapvec
;
1108 widget_value
**submenu_stack
;
1109 int previous_items
= menu_items_used
;
1110 int top_level_items
= 0;
1112 length
= Flength (maps
);
1113 len
= XINT (length
);
1115 /* Convert the list MAPS into a vector MAPVEC. */
1116 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1117 for (i
= 0; i
< len
; i
++)
1119 mapvec
[i
] = Fcar (maps
);
1123 menu_items_n_panes
= 0;
1125 /* Loop over the given keymaps, making a pane for each map.
1126 But don't make a pane that is empty--ignore that map instead. */
1127 for (i
= 0; i
< len
; i
++)
1129 if (SYMBOLP (mapvec
[i
])
1130 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1132 /* Here we have a command at top level in the menu bar
1133 as opposed to a submenu. */
1134 top_level_items
= 1;
1135 push_menu_pane (Qnil
, Qnil
);
1136 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1137 Qnil
, Qnil
, Qnil
, Qnil
);
1140 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1143 /* Create a tree of widget_value objects
1144 representing the panes and their items. */
1147 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1148 wv
= xmalloc_widget_value ();
1152 wv
->button_type
= BUTTON_TYPE_NONE
;
1158 /* Loop over all panes and items made during this call
1159 and construct a tree of widget_value objects.
1160 Ignore the panes and items made by previous calls to
1161 single_submenu, even though those are also in menu_items. */
1163 while (i
< menu_items_used
)
1165 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1167 submenu_stack
[submenu_depth
++] = save_wv
;
1172 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1175 save_wv
= submenu_stack
[--submenu_depth
];
1178 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1179 && submenu_depth
!= 0)
1180 i
+= MENU_ITEMS_PANE_LENGTH
;
1181 /* Ignore a nil in the item list.
1182 It's meaningful only for dialog boxes. */
1183 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1185 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1187 /* Create a new pane. */
1188 Lisp_Object pane_name
, prefix
;
1191 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1192 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1194 #ifndef HAVE_MULTILINGUAL_MENU
1195 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1197 pane_name
= ENCODE_SYSTEM (pane_name
);
1198 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1201 pane_string
= (NILP (pane_name
)
1202 ? "" : (char *) SDATA (pane_name
));
1203 /* If there is just one top-level pane, put all its items directly
1204 under the top-level menu. */
1205 if (menu_items_n_panes
== 1)
1208 /* If the pane has a meaningful name,
1209 make the pane a top-level menu item
1210 with its items as a submenu beneath it. */
1211 if (strcmp (pane_string
, ""))
1213 wv
= xmalloc_widget_value ();
1217 first_wv
->contents
= wv
;
1218 wv
->name
= pane_string
;
1219 /* Ignore the @ that means "separate pane".
1220 This is a kludge, but this isn't worth more time. */
1221 if (!NILP (prefix
) && wv
->name
[0] == '@')
1225 wv
->button_type
= BUTTON_TYPE_NONE
;
1230 i
+= MENU_ITEMS_PANE_LENGTH
;
1234 /* Create a new item within current pane. */
1235 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1238 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1239 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1240 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1241 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1242 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1243 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1244 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1246 #ifndef HAVE_MULTILINGUAL_MENU
1247 if (STRING_MULTIBYTE (item_name
))
1249 item_name
= ENCODE_SYSTEM (item_name
);
1250 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1253 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1255 descrip
= ENCODE_SYSTEM (descrip
);
1256 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1258 #endif /* not HAVE_MULTILINGUAL_MENU */
1260 wv
= xmalloc_widget_value ();
1264 save_wv
->contents
= wv
;
1266 wv
->name
= (char *) SDATA (item_name
);
1267 if (!NILP (descrip
))
1268 wv
->key
= (char *) SDATA (descrip
);
1270 /* The EMACS_INT cast avoids a warning. There's no problem
1271 as long as pointers have enough bits to hold small integers. */
1272 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1273 wv
->enabled
= !NILP (enable
);
1276 wv
->button_type
= BUTTON_TYPE_NONE
;
1277 else if (EQ (type
, QCradio
))
1278 wv
->button_type
= BUTTON_TYPE_RADIO
;
1279 else if (EQ (type
, QCtoggle
))
1280 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1284 wv
->selected
= !NILP (selected
);
1285 if (!STRINGP (help
))
1292 i
+= MENU_ITEMS_ITEM_LENGTH
;
1296 /* If we have just one "menu item"
1297 that was originally a button, return it by itself. */
1298 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1300 wv
= first_wv
->contents
;
1301 free_widget_value (first_wv
);
1308 /* Set the contents of the menubar widgets of frame F.
1309 The argument FIRST_TIME is currently ignored;
1310 it is set the first time this is called, from initialize_frame_menubar. */
1313 set_frame_menubar (f
, first_time
, deep_p
)
1318 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1320 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1323 /* We must not change the menubar when actually in use. */
1324 if (f
->output_data
.mac
->menubar_active
)
1327 XSETFRAME (Vmenu_updating_frame
, f
);
1329 if (! menubar_widget
)
1331 else if (pending_menu_activation
&& !deep_p
)
1334 wv
= xmalloc_widget_value ();
1335 wv
->name
= "menubar";
1338 wv
->button_type
= BUTTON_TYPE_NONE
;
1344 /* Make a widget-value tree representing the entire menu trees. */
1346 struct buffer
*prev
= current_buffer
;
1348 int specpdl_count
= SPECPDL_INDEX ();
1349 int previous_menu_items_used
= f
->menu_bar_items_used
;
1350 Lisp_Object
*previous_items
1351 = (Lisp_Object
*) alloca (previous_menu_items_used
1352 * sizeof (Lisp_Object
));
1354 /* If we are making a new widget, its contents are empty,
1355 do always reinitialize them. */
1356 if (! menubar_widget
)
1357 previous_menu_items_used
= 0;
1359 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1360 specbind (Qinhibit_quit
, Qt
);
1361 /* Don't let the debugger step into this code
1362 because it is not reentrant. */
1363 specbind (Qdebug_on_next_call
, Qnil
);
1365 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1366 if (NILP (Voverriding_local_map_menu_flag
))
1368 specbind (Qoverriding_terminal_local_map
, Qnil
);
1369 specbind (Qoverriding_local_map
, Qnil
);
1372 set_buffer_internal_1 (XBUFFER (buffer
));
1374 /* Run the Lucid hook. */
1375 safe_run_hooks (Qactivate_menubar_hook
);
1376 /* If it has changed current-menubar from previous value,
1377 really recompute the menubar from the value. */
1378 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1379 call0 (Qrecompute_lucid_menubar
);
1380 safe_run_hooks (Qmenu_bar_update_hook
);
1381 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1383 items
= FRAME_MENU_BAR_ITEMS (f
);
1385 inhibit_garbage_collection ();
1387 /* Save the frame's previous menu bar contents data. */
1388 if (previous_menu_items_used
)
1389 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1390 previous_menu_items_used
* sizeof (Lisp_Object
));
1392 /* Fill in the current menu bar contents. */
1393 menu_items
= f
->menu_bar_vector
;
1394 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1396 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1398 Lisp_Object key
, string
, maps
;
1400 key
= XVECTOR (items
)->contents
[i
];
1401 string
= XVECTOR (items
)->contents
[i
+ 1];
1402 maps
= XVECTOR (items
)->contents
[i
+ 2];
1406 wv
= single_submenu (key
, string
, maps
);
1410 first_wv
->contents
= wv
;
1411 /* Don't set wv->name here; GC during the loop might relocate it. */
1413 wv
->button_type
= BUTTON_TYPE_NONE
;
1417 finish_menu_items ();
1419 set_buffer_internal_1 (prev
);
1420 unbind_to (specpdl_count
, Qnil
);
1422 /* If there has been no change in the Lisp-level contents
1423 of the menu bar, skip redisplaying it. Just exit. */
1425 for (i
= 0; i
< previous_menu_items_used
; i
++)
1426 if (menu_items_used
== i
1427 || (NILP (Fequal (previous_items
[i
],
1428 XVECTOR (menu_items
)->contents
[i
]))))
1430 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1432 free_menubar_widget_value_tree (first_wv
);
1438 /* Now GC cannot happen during the lifetime of the widget_value,
1439 so it's safe to store data from a Lisp_String, as long as
1440 local copies are made when the actual menu is created.
1441 Windows takes care of this for normal string items, but
1442 not for owner-drawn items or additional item-info. */
1443 wv
= first_wv
->contents
;
1444 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1447 string
= XVECTOR (items
)->contents
[i
+ 1];
1450 wv
->name
= (char *) SDATA (string
);
1454 f
->menu_bar_vector
= menu_items
;
1455 f
->menu_bar_items_used
= menu_items_used
;
1460 /* Make a widget-value tree containing
1461 just the top level menu bar strings. */
1463 items
= FRAME_MENU_BAR_ITEMS (f
);
1464 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1468 string
= XVECTOR (items
)->contents
[i
+ 1];
1472 wv
= xmalloc_widget_value ();
1473 wv
->name
= (char *) SDATA (string
);
1476 wv
->button_type
= BUTTON_TYPE_NONE
;
1478 /* This prevents lwlib from assuming this
1479 menu item is really supposed to be empty. */
1480 /* The EMACS_INT cast avoids a warning.
1481 This value just has to be different from small integers. */
1482 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1487 first_wv
->contents
= wv
;
1491 /* Forget what we thought we knew about what is in the
1492 detailed contents of the menu bar menus.
1493 Changing the top level always destroys the contents. */
1494 f
->menu_bar_items_used
= 0;
1497 /* Create or update the menu bar widget. */
1501 /* Non-null value to indicate menubar has already been "created". */
1502 f
->output_data
.mac
->menubar_widget
= 1;
1505 int i
= MIN_MENU_ID
;
1506 MenuHandle menu
= GetMenuHandle (i
);
1507 while (menu
!= NULL
)
1511 menu
= GetMenuHandle (++i
);
1515 menu
= GetMenuHandle (i
);
1516 while (menu
!= NULL
)
1520 menu
= GetMenuHandle (++i
);
1524 fill_menubar (first_wv
->contents
);
1528 free_menubar_widget_value_tree (first_wv
);
1533 /* Called from Fx_create_frame to create the initial menubar of a frame
1534 before it is mapped, so that the window is mapped with the menubar already
1535 there instead of us tacking it on later and thrashing the window after it
1539 initialize_frame_menubar (f
)
1542 /* This function is called before the first chance to redisplay
1543 the frame. It has to be, so the frame will have the right size. */
1544 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1545 set_frame_menubar (f
, 1, 1);
1548 /* Get rid of the menu bar of frame F, and free its storage.
1549 This is used when deleting a frame, and when turning off the menu bar. */
1552 free_frame_menubar (f
)
1555 f
->output_data
.mac
->menubar_widget
= NULL
;
1559 /* mac_menu_show actually displays a menu using the panes and items in
1560 menu_items and returns the value selected from it; we assume input
1561 is blocked by the caller. */
1563 /* F is the frame the menu is for.
1564 X and Y are the frame-relative specified position,
1565 relative to the inside upper left corner of the frame F.
1566 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1567 KEYMAPS is 1 if this menu was specified with keymaps;
1568 in that case, we return a list containing the chosen item's value
1569 and perhaps also the pane's prefix.
1570 TITLE is the specified menu title.
1571 ERROR is a place to store an error message string in case of failure.
1572 (We return nil on failure, but the value doesn't actually matter.) */
1575 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1586 int menu_item_choice
;
1587 int menu_item_selection
;
1590 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1591 widget_value
**submenu_stack
1592 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1593 Lisp_Object
*subprefix_stack
1594 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1595 int submenu_depth
= 0;
1600 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1602 *error
= "Empty menu";
1606 /* Create a tree of widget_value objects
1607 representing the panes and their items. */
1608 wv
= xmalloc_widget_value ();
1612 wv
->button_type
= BUTTON_TYPE_NONE
;
1617 /* Loop over all panes and items, filling in the tree. */
1619 while (i
< menu_items_used
)
1621 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1623 submenu_stack
[submenu_depth
++] = save_wv
;
1629 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1632 save_wv
= submenu_stack
[--submenu_depth
];
1636 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1637 && submenu_depth
!= 0)
1638 i
+= MENU_ITEMS_PANE_LENGTH
;
1639 /* Ignore a nil in the item list.
1640 It's meaningful only for dialog boxes. */
1641 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1643 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1645 /* Create a new pane. */
1646 Lisp_Object pane_name
, prefix
;
1648 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1649 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1650 #ifndef HAVE_MULTILINGUAL_MENU
1651 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1653 pane_name
= ENCODE_SYSTEM (pane_name
);
1654 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1657 pane_string
= (NILP (pane_name
)
1658 ? "" : (char *) SDATA (pane_name
));
1659 /* If there is just one top-level pane, put all its items directly
1660 under the top-level menu. */
1661 if (menu_items_n_panes
== 1)
1664 /* If the pane has a meaningful name,
1665 make the pane a top-level menu item
1666 with its items as a submenu beneath it. */
1667 if (!keymaps
&& strcmp (pane_string
, ""))
1669 wv
= xmalloc_widget_value ();
1673 first_wv
->contents
= wv
;
1674 wv
->name
= pane_string
;
1675 if (keymaps
&& !NILP (prefix
))
1679 wv
->button_type
= BUTTON_TYPE_NONE
;
1684 else if (first_pane
)
1690 i
+= MENU_ITEMS_PANE_LENGTH
;
1694 /* Create a new item within current pane. */
1695 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1697 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1698 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1699 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1700 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1701 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1702 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1703 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1705 #ifndef HAVE_MULTILINGUAL_MENU
1706 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1708 item_name
= ENCODE_SYSTEM (item_name
);
1709 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1711 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1713 descrip
= ENCODE_SYSTEM (descrip
);
1714 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1716 #endif /* not HAVE_MULTILINGUAL_MENU */
1718 wv
= xmalloc_widget_value ();
1722 save_wv
->contents
= wv
;
1723 wv
->name
= (char *) SDATA (item_name
);
1724 if (!NILP (descrip
))
1725 wv
->key
= (char *) SDATA (descrip
);
1727 /* Use the contents index as call_data, since we are
1728 restricted to 16-bits. */
1729 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1730 wv
->enabled
= !NILP (enable
);
1733 wv
->button_type
= BUTTON_TYPE_NONE
;
1734 else if (EQ (type
, QCtoggle
))
1735 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1736 else if (EQ (type
, QCradio
))
1737 wv
->button_type
= BUTTON_TYPE_RADIO
;
1741 wv
->selected
= !NILP (selected
);
1742 if (!STRINGP (help
))
1749 i
+= MENU_ITEMS_ITEM_LENGTH
;
1753 /* Deal with the title, if it is non-nil. */
1756 widget_value
*wv_title
= xmalloc_widget_value ();
1757 widget_value
*wv_sep
= xmalloc_widget_value ();
1759 /* Maybe replace this separator with a bitmap or owner-draw item
1760 so that it looks better. Having two separators looks odd. */
1761 wv_sep
->name
= "--";
1762 wv_sep
->next
= first_wv
->contents
;
1763 wv_sep
->help
= Qnil
;
1765 #ifndef HAVE_MULTILINGUAL_MENU
1766 if (STRING_MULTIBYTE (title
))
1767 title
= ENCODE_SYSTEM (title
);
1769 wv_title
->name
= (char *) SDATA (title
);
1770 wv_title
->enabled
= TRUE
;
1771 wv_title
->title
= TRUE
;
1772 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1773 wv_title
->help
= Qnil
;
1774 wv_title
->next
= wv_sep
;
1775 first_wv
->contents
= wv_title
;
1778 /* Actually create the menu. */
1779 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1780 submenu_id
= MIN_POPUP_SUBMENU_ID
;
1781 fill_submenu (menu
, first_wv
->contents
);
1783 /* Adjust coordinates to be root-window-relative. */
1787 SetPortWindowPort (FRAME_MAC_WINDOW (f
));
1789 LocalToGlobal (&pos
);
1791 /* No selection has been chosen yet. */
1792 menu_item_choice
= 0;
1793 menu_item_selection
= 0;
1795 InsertMenu (menu
, -1);
1797 /* Display the menu. */
1798 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
1799 menu_item_selection
= LoWord (menu_item_choice
);
1801 /* Get the refcon to find the correct item*/
1802 if (menu_item_selection
)
1804 menu
= GetMenuHandle (HiWord (menu_item_choice
));
1806 GetMenuItemRefCon (menu
, menu_item_selection
, &refcon
);
1811 /* Clean up extraneous mouse events which might have been generated
1813 discard_mouse_events ();
1816 /* Free the widget_value objects we used to specify the
1818 free_menubar_widget_value_tree (first_wv
);
1820 /* delete all menus */
1822 int i
= MIN_POPUP_SUBMENU_ID
;
1823 MenuHandle submenu
= GetMenuHandle (i
);
1824 while (menu
!= NULL
)
1828 menu
= GetMenuHandle (++i
);
1832 DeleteMenu (POPUP_SUBMENU_ID
);
1835 /* Find the selected item, and its pane, to return
1836 the proper value. */
1837 if (menu_item_selection
!= 0)
1839 Lisp_Object prefix
, entry
;
1841 prefix
= entry
= Qnil
;
1843 while (i
< menu_items_used
)
1845 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1847 subprefix_stack
[submenu_depth
++] = prefix
;
1851 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1853 prefix
= subprefix_stack
[--submenu_depth
];
1856 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1859 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1860 i
+= MENU_ITEMS_PANE_LENGTH
;
1862 /* Ignore a nil in the item list.
1863 It's meaningful only for dialog boxes. */
1864 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1869 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1870 if ((int) (EMACS_INT
) refcon
== i
)
1876 entry
= Fcons (entry
, Qnil
);
1878 entry
= Fcons (prefix
, entry
);
1879 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1880 if (!NILP (subprefix_stack
[j
]))
1881 entry
= Fcons (subprefix_stack
[j
], entry
);
1885 i
+= MENU_ITEMS_ITEM_LENGTH
;
1895 /* Construct native Mac OS menubar based on widget_value tree. */
1898 mac_dialog (widget_value
*wv
)
1902 char **button_labels
;
1909 WindowPtr window_ptr
;
1912 EventRecord event_record
;
1914 int control_part_code
;
1917 dialog_name
= wv
->name
;
1918 nb_buttons
= dialog_name
[1] - '0';
1919 left_count
= nb_buttons
- (dialog_name
[4] - '0');
1920 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
1921 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
1924 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
1925 strcpy (prompt
, wv
->value
);
1929 for (i
= 0; i
< nb_buttons
; i
++)
1931 button_labels
[i
] = wv
->value
;
1932 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
1933 strcpy (button_labels
[i
], wv
->value
);
1934 c2pstr (button_labels
[i
]);
1935 ref_cons
[i
] = (UInt32
) wv
->call_data
;
1939 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
1941 SetPortWindowPort (window_ptr
);
1944 /* Left and right margins in the dialog are 13 pixels each.*/
1946 /* Calculate width of dialog box: 8 pixels on each side of the text
1947 label in each button, 12 pixels between buttons. */
1948 for (i
= 0; i
< nb_buttons
; i
++)
1949 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1951 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1954 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
1956 SizeWindow (window_ptr
, dialog_width
, 78, 0);
1957 ShowWindow (window_ptr
);
1959 SetPortWindowPort (window_ptr
);
1964 DrawString (prompt
);
1967 for (i
= 0; i
< nb_buttons
; i
++)
1969 int button_width
= StringWidth (button_labels
[i
]) + 16;
1970 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
1971 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
1972 kControlPushButtonProc
, ref_cons
[i
]);
1973 left
+= button_width
+ 12;
1974 if (i
== left_count
- 1)
1981 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
1982 if (event_record
.what
== mouseDown
)
1984 part_code
= FindWindow (event_record
.where
, &window_ptr
);
1985 if (part_code
== inContent
)
1987 mouse
= event_record
.where
;
1988 GlobalToLocal (&mouse
);
1989 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
1990 if (control_part_code
== kControlButtonPart
)
1991 if (TrackControl (ch
, mouse
, NULL
))
1992 i
= GetControlReference (ch
);
1997 DisposeWindow (window_ptr
);
2002 static char * button_names
[] = {
2003 "button1", "button2", "button3", "button4", "button5",
2004 "button6", "button7", "button8", "button9", "button10" };
2007 mac_dialog_show (f
, keymaps
, title
, error
)
2013 int i
, nb_buttons
=0;
2014 char dialog_name
[6];
2015 int menu_item_selection
;
2017 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2019 /* Number of elements seen so far, before boundary. */
2021 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2022 int boundary_seen
= 0;
2026 if (menu_items_n_panes
> 1)
2028 *error
= "Multiple panes in dialog box";
2032 /* Create a tree of widget_value objects
2033 representing the text label and buttons. */
2035 Lisp_Object pane_name
, prefix
;
2037 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2038 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2039 pane_string
= (NILP (pane_name
)
2040 ? "" : (char *) SDATA (pane_name
));
2041 prev_wv
= xmalloc_widget_value ();
2042 prev_wv
->value
= pane_string
;
2043 if (keymaps
&& !NILP (prefix
))
2045 prev_wv
->enabled
= 1;
2046 prev_wv
->name
= "message";
2047 prev_wv
->help
= Qnil
;
2050 /* Loop over all panes and items, filling in the tree. */
2051 i
= MENU_ITEMS_PANE_LENGTH
;
2052 while (i
< menu_items_used
)
2055 /* Create a new item within current pane. */
2056 Lisp_Object item_name
, enable
, descrip
, help
;
2058 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2059 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2061 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2062 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2064 if (NILP (item_name
))
2066 free_menubar_widget_value_tree (first_wv
);
2067 *error
= "Submenu in dialog items";
2070 if (EQ (item_name
, Qquote
))
2072 /* This is the boundary between left-side elts
2073 and right-side elts. Stop incrementing right_count. */
2078 if (nb_buttons
>= 9)
2080 free_menubar_widget_value_tree (first_wv
);
2081 *error
= "Too many dialog items";
2085 wv
= xmalloc_widget_value ();
2087 wv
->name
= (char *) button_names
[nb_buttons
];
2088 if (!NILP (descrip
))
2089 wv
->key
= (char *) SDATA (descrip
);
2090 wv
->value
= (char *) SDATA (item_name
);
2091 wv
->call_data
= (void *) i
;
2092 /* menu item is identified by its index in menu_items table */
2093 wv
->enabled
= !NILP (enable
);
2097 if (! boundary_seen
)
2101 i
+= MENU_ITEMS_ITEM_LENGTH
;
2104 /* If the boundary was not specified,
2105 by default put half on the left and half on the right. */
2106 if (! boundary_seen
)
2107 left_count
= nb_buttons
- nb_buttons
/ 2;
2109 wv
= xmalloc_widget_value ();
2110 wv
->name
= dialog_name
;
2113 /* Dialog boxes use a really stupid name encoding
2114 which specifies how many buttons to use
2115 and how many buttons are on the right.
2116 The Q means something also. */
2117 dialog_name
[0] = 'Q';
2118 dialog_name
[1] = '0' + nb_buttons
;
2119 dialog_name
[2] = 'B';
2120 dialog_name
[3] = 'R';
2121 /* Number of buttons to put on the right. */
2122 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2124 wv
->contents
= first_wv
;
2128 /* Actually create the dialog. */
2130 menu_item_selection
= mac_dialog (first_wv
);
2132 menu_item_selection
= 0;
2135 /* Free the widget_value objects we used to specify the contents. */
2136 free_menubar_widget_value_tree (first_wv
);
2138 /* Find the selected item, and its pane, to return the proper
2140 if (menu_item_selection
!= 0)
2146 while (i
< menu_items_used
)
2150 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2153 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2154 i
+= MENU_ITEMS_PANE_LENGTH
;
2159 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2160 if (menu_item_selection
== i
)
2164 entry
= Fcons (entry
, Qnil
);
2166 entry
= Fcons (prefix
, entry
);
2170 i
+= MENU_ITEMS_ITEM_LENGTH
;
2177 #endif /* HAVE_DIALOGS */
2180 /* Is this item a separator? */
2182 name_is_separator (name
)
2187 /* Check if name string consists of only dashes ('-'). */
2188 while (*name
== '-') name
++;
2189 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2190 or "--deep-shadow". We don't implement them yet, se we just treat
2191 them like normal separators. */
2192 return (*name
== '\0' || start
+ 2 == name
);
2196 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
,
2202 if (name_is_separator (wv
->name
))
2203 AppendMenu (menu
, "\p-");
2206 AppendMenu (menu
, "\pX");
2208 #if TARGET_API_MAC_CARBON
2209 pos
= CountMenuItems (menu
);
2211 pos
= CountMItems (menu
);
2214 strcpy (item_name
, "");
2215 strncat (item_name
, wv
->name
, 255);
2216 if (wv
->key
!= NULL
)
2218 strncat (item_name
, " ", 255);
2219 strncat (item_name
, wv
->key
, 255);
2223 SetMenuItemText (menu
, pos
, item_name
);
2225 if (wv
->enabled
&& !force_disable
)
2226 #if TARGET_API_MAC_CARBON
2227 EnableMenuItem (menu
, pos
);
2229 EnableItem (menu
, pos
);
2232 #if TARGET_API_MAC_CARBON
2233 DisableMenuItem (menu
, pos
);
2235 DisableItem (menu
, pos
);
2238 /* Draw radio buttons and tickboxes. */
2240 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2241 wv
->button_type
== BUTTON_TYPE_RADIO
))
2242 SetItemMark (menu
, pos
, checkMark
);
2244 SetItemMark (menu
, pos
, noMark
);
2248 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2250 if (submenu
!= NULL
)
2251 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2254 /* Construct native Mac OS menubar based on widget_value tree. */
2257 fill_submenu (MenuHandle menu
, widget_value
*wv
)
2259 for ( ; wv
!= NULL
; wv
= wv
->next
)
2262 int cur_submenu
= submenu_id
++;
2263 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2264 fill_submenu (submenu
, wv
->contents
);
2265 InsertMenu (submenu
, -1);
2266 add_menu_item (menu
, wv
, cur_submenu
, 0);
2269 add_menu_item (menu
, wv
, NULL
, 0);
2273 /* Construct native Mac OS menu based on widget_value tree. */
2276 fill_menu (MenuHandle menu
, widget_value
*wv
)
2278 for ( ; wv
!= NULL
; wv
= wv
->next
)
2281 int cur_submenu
= submenu_id
++;
2282 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2283 fill_submenu (submenu
, wv
->contents
);
2284 InsertMenu (submenu
, -1);
2285 add_menu_item (menu
, wv
, cur_submenu
, 0);
2288 add_menu_item (menu
, wv
, NULL
, 0);
2291 /* Construct native Mac OS menubar based on widget_value tree. */
2294 fill_menubar (widget_value
*wv
)
2298 submenu_id
= MIN_SUBMENU_ID
;
2300 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2305 strncpy (title
, wv
->name
, 255);
2308 menu
= NewMenu (id
, title
);
2311 fill_menu (menu
, wv
->contents
);
2313 InsertMenu (menu
, 0);
2317 #endif /* HAVE_MENUS */
2323 staticpro (&menu_items
);
2326 Qdebug_on_next_call
= intern ("debug-on-next-call");
2327 staticpro (&Qdebug_on_next_call
);
2329 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2330 doc
: /* Frame for which we are updating a menu.
2331 The enable predicate for a menu command should check this variable. */);
2332 Vmenu_updating_frame
= Qnil
;
2334 defsubr (&Sx_popup_menu
);
2336 defsubr (&Sx_popup_dialog
);
2340 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2341 (do not change this comment) */