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 || (!Fequal (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1429 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1431 free_menubar_widget_value_tree (first_wv
);
1437 /* Now GC cannot happen during the lifetime of the widget_value,
1438 so it's safe to store data from a Lisp_String, as long as
1439 local copies are made when the actual menu is created.
1440 Windows takes care of this for normal string items, but
1441 not for owner-drawn items or additional item-info. */
1442 wv
= first_wv
->contents
;
1443 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1446 string
= XVECTOR (items
)->contents
[i
+ 1];
1449 wv
->name
= (char *) SDATA (string
);
1453 f
->menu_bar_vector
= menu_items
;
1454 f
->menu_bar_items_used
= menu_items_used
;
1459 /* Make a widget-value tree containing
1460 just the top level menu bar strings. */
1462 items
= FRAME_MENU_BAR_ITEMS (f
);
1463 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1467 string
= XVECTOR (items
)->contents
[i
+ 1];
1471 wv
= xmalloc_widget_value ();
1472 wv
->name
= (char *) SDATA (string
);
1475 wv
->button_type
= BUTTON_TYPE_NONE
;
1477 /* This prevents lwlib from assuming this
1478 menu item is really supposed to be empty. */
1479 /* The EMACS_INT cast avoids a warning.
1480 This value just has to be different from small integers. */
1481 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1486 first_wv
->contents
= wv
;
1490 /* Forget what we thought we knew about what is in the
1491 detailed contents of the menu bar menus.
1492 Changing the top level always destroys the contents. */
1493 f
->menu_bar_items_used
= 0;
1496 /* Create or update the menu bar widget. */
1500 /* Non-null value to indicate menubar has already been "created". */
1501 f
->output_data
.mac
->menubar_widget
= 1;
1504 int i
= MIN_MENU_ID
;
1505 MenuHandle menu
= GetMenuHandle (i
);
1506 while (menu
!= NULL
)
1510 menu
= GetMenuHandle (++i
);
1514 menu
= GetMenuHandle (i
);
1515 while (menu
!= NULL
)
1519 menu
= GetMenuHandle (++i
);
1523 fill_menubar (first_wv
->contents
);
1527 free_menubar_widget_value_tree (first_wv
);
1532 /* Called from Fx_create_frame to create the initial menubar of a frame
1533 before it is mapped, so that the window is mapped with the menubar already
1534 there instead of us tacking it on later and thrashing the window after it
1538 initialize_frame_menubar (f
)
1541 /* This function is called before the first chance to redisplay
1542 the frame. It has to be, so the frame will have the right size. */
1543 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1544 set_frame_menubar (f
, 1, 1);
1547 /* Get rid of the menu bar of frame F, and free its storage.
1548 This is used when deleting a frame, and when turning off the menu bar. */
1551 free_frame_menubar (f
)
1554 f
->output_data
.mac
->menubar_widget
= NULL
;
1558 /* mac_menu_show actually displays a menu using the panes and items in
1559 menu_items and returns the value selected from it; we assume input
1560 is blocked by the caller. */
1562 /* F is the frame the menu is for.
1563 X and Y are the frame-relative specified position,
1564 relative to the inside upper left corner of the frame F.
1565 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1566 KEYMAPS is 1 if this menu was specified with keymaps;
1567 in that case, we return a list containing the chosen item's value
1568 and perhaps also the pane's prefix.
1569 TITLE is the specified menu title.
1570 ERROR is a place to store an error message string in case of failure.
1571 (We return nil on failure, but the value doesn't actually matter.) */
1574 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1585 int menu_item_choice
;
1586 int menu_item_selection
;
1589 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1590 widget_value
**submenu_stack
1591 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1592 Lisp_Object
*subprefix_stack
1593 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1594 int submenu_depth
= 0;
1599 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1601 *error
= "Empty menu";
1605 /* Create a tree of widget_value objects
1606 representing the panes and their items. */
1607 wv
= xmalloc_widget_value ();
1611 wv
->button_type
= BUTTON_TYPE_NONE
;
1616 /* Loop over all panes and items, filling in the tree. */
1618 while (i
< menu_items_used
)
1620 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1622 submenu_stack
[submenu_depth
++] = save_wv
;
1628 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1631 save_wv
= submenu_stack
[--submenu_depth
];
1635 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1636 && submenu_depth
!= 0)
1637 i
+= MENU_ITEMS_PANE_LENGTH
;
1638 /* Ignore a nil in the item list.
1639 It's meaningful only for dialog boxes. */
1640 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1642 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1644 /* Create a new pane. */
1645 Lisp_Object pane_name
, prefix
;
1647 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1648 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1649 #ifndef HAVE_MULTILINGUAL_MENU
1650 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1652 pane_name
= ENCODE_SYSTEM (pane_name
);
1653 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1656 pane_string
= (NILP (pane_name
)
1657 ? "" : (char *) SDATA (pane_name
));
1658 /* If there is just one top-level pane, put all its items directly
1659 under the top-level menu. */
1660 if (menu_items_n_panes
== 1)
1663 /* If the pane has a meaningful name,
1664 make the pane a top-level menu item
1665 with its items as a submenu beneath it. */
1666 if (!keymaps
&& strcmp (pane_string
, ""))
1668 wv
= xmalloc_widget_value ();
1672 first_wv
->contents
= wv
;
1673 wv
->name
= pane_string
;
1674 if (keymaps
&& !NILP (prefix
))
1678 wv
->button_type
= BUTTON_TYPE_NONE
;
1683 else if (first_pane
)
1689 i
+= MENU_ITEMS_PANE_LENGTH
;
1693 /* Create a new item within current pane. */
1694 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1696 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1697 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1698 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1699 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1700 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1701 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1702 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1704 #ifndef HAVE_MULTILINGUAL_MENU
1705 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1707 item_name
= ENCODE_SYSTEM (item_name
);
1708 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1710 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1712 descrip
= ENCODE_SYSTEM (descrip
);
1713 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1715 #endif /* not HAVE_MULTILINGUAL_MENU */
1717 wv
= xmalloc_widget_value ();
1721 save_wv
->contents
= wv
;
1722 wv
->name
= (char *) SDATA (item_name
);
1723 if (!NILP (descrip
))
1724 wv
->key
= (char *) SDATA (descrip
);
1726 /* Use the contents index as call_data, since we are
1727 restricted to 16-bits. */
1728 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1729 wv
->enabled
= !NILP (enable
);
1732 wv
->button_type
= BUTTON_TYPE_NONE
;
1733 else if (EQ (type
, QCtoggle
))
1734 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1735 else if (EQ (type
, QCradio
))
1736 wv
->button_type
= BUTTON_TYPE_RADIO
;
1740 wv
->selected
= !NILP (selected
);
1741 if (!STRINGP (help
))
1748 i
+= MENU_ITEMS_ITEM_LENGTH
;
1752 /* Deal with the title, if it is non-nil. */
1755 widget_value
*wv_title
= xmalloc_widget_value ();
1756 widget_value
*wv_sep
= xmalloc_widget_value ();
1758 /* Maybe replace this separator with a bitmap or owner-draw item
1759 so that it looks better. Having two separators looks odd. */
1760 wv_sep
->name
= "--";
1761 wv_sep
->next
= first_wv
->contents
;
1762 wv_sep
->help
= Qnil
;
1764 #ifndef HAVE_MULTILINGUAL_MENU
1765 if (STRING_MULTIBYTE (title
))
1766 title
= ENCODE_SYSTEM (title
);
1768 wv_title
->name
= (char *) SDATA (title
);
1769 wv_title
->enabled
= TRUE
;
1770 wv_title
->title
= TRUE
;
1771 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1772 wv_title
->help
= Qnil
;
1773 wv_title
->next
= wv_sep
;
1774 first_wv
->contents
= wv_title
;
1777 /* Actually create the menu. */
1778 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1779 submenu_id
= MIN_POPUP_SUBMENU_ID
;
1780 fill_submenu (menu
, first_wv
->contents
);
1782 /* Adjust coordinates to be root-window-relative. */
1786 #if TARGET_API_MAC_CARBON
1787 SetPort (GetWindowPort (FRAME_MAC_WINDOW (f
)));
1789 SetPort (FRAME_MAC_WINDOW (f
));
1792 LocalToGlobal (&pos
);
1794 /* No selection has been chosen yet. */
1795 menu_item_choice
= 0;
1796 menu_item_selection
= 0;
1798 InsertMenu (menu
, -1);
1800 /* Display the menu. */
1801 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
1802 menu_item_selection
= LoWord (menu_item_choice
);
1804 /* Get the refcon to find the correct item*/
1805 if (menu_item_selection
)
1807 menu
= GetMenuHandle (HiWord (menu_item_choice
));
1809 GetMenuItemRefCon (menu
, menu_item_selection
, &refcon
);
1814 /* Clean up extraneous mouse events which might have been generated
1816 discard_mouse_events ();
1819 /* Free the widget_value objects we used to specify the
1821 free_menubar_widget_value_tree (first_wv
);
1823 /* delete all menus */
1825 int i
= MIN_POPUP_SUBMENU_ID
;
1826 MenuHandle submenu
= GetMenuHandle (i
);
1827 while (menu
!= NULL
)
1831 menu
= GetMenuHandle (++i
);
1835 DeleteMenu (POPUP_SUBMENU_ID
);
1838 /* Find the selected item, and its pane, to return
1839 the proper value. */
1840 if (menu_item_selection
!= 0)
1842 Lisp_Object prefix
, entry
;
1844 prefix
= entry
= Qnil
;
1846 while (i
< menu_items_used
)
1848 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1850 subprefix_stack
[submenu_depth
++] = prefix
;
1854 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1856 prefix
= subprefix_stack
[--submenu_depth
];
1859 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1862 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1863 i
+= MENU_ITEMS_PANE_LENGTH
;
1865 /* Ignore a nil in the item list.
1866 It's meaningful only for dialog boxes. */
1867 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1872 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1873 if ((int) (EMACS_INT
) refcon
== i
)
1879 entry
= Fcons (entry
, Qnil
);
1881 entry
= Fcons (prefix
, entry
);
1882 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1883 if (!NILP (subprefix_stack
[j
]))
1884 entry
= Fcons (subprefix_stack
[j
], entry
);
1888 i
+= MENU_ITEMS_ITEM_LENGTH
;
1898 /* Construct native Mac OS menubar based on widget_value tree. */
1901 mac_dialog (widget_value
*wv
)
1905 char **button_labels
;
1912 WindowPtr window_ptr
;
1915 EventRecord event_record
;
1917 int control_part_code
;
1920 dialog_name
= wv
->name
;
1921 nb_buttons
= dialog_name
[1] - '0';
1922 left_count
= nb_buttons
- (dialog_name
[4] - '0');
1923 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
1924 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
1927 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
1928 strcpy (prompt
, wv
->value
);
1932 for (i
= 0; i
< nb_buttons
; i
++)
1934 button_labels
[i
] = wv
->value
;
1935 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
1936 strcpy (button_labels
[i
], wv
->value
);
1937 c2pstr (button_labels
[i
]);
1938 ref_cons
[i
] = (UInt32
) wv
->call_data
;
1942 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
1944 #if TARGET_API_MAC_CARBON
1945 SetPort (GetWindowPort (window_ptr
));
1947 SetPort (window_ptr
);
1951 /* Left and right margins in the dialog are 13 pixels each.*/
1953 /* Calculate width of dialog box: 8 pixels on each side of the text
1954 label in each button, 12 pixels between buttons. */
1955 for (i
= 0; i
< nb_buttons
; i
++)
1956 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1958 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1961 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
1963 SizeWindow (window_ptr
, dialog_width
, 78, 0);
1964 ShowWindow (window_ptr
);
1966 #if TARGET_API_MAC_CARBON
1967 SetPort (GetWindowPort (window_ptr
));
1969 SetPort (window_ptr
);
1975 DrawString (prompt
);
1978 for (i
= 0; i
< nb_buttons
; i
++)
1980 int button_width
= StringWidth (button_labels
[i
]) + 16;
1981 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
1982 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
1983 kControlPushButtonProc
, ref_cons
[i
]);
1984 left
+= button_width
+ 12;
1985 if (i
== left_count
- 1)
1992 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
1993 if (event_record
.what
== mouseDown
)
1995 part_code
= FindWindow (event_record
.where
, &window_ptr
);
1996 if (part_code
== inContent
)
1998 mouse
= event_record
.where
;
1999 GlobalToLocal (&mouse
);
2000 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2001 if (control_part_code
== kControlButtonPart
)
2002 if (TrackControl (ch
, mouse
, NULL
))
2003 i
= GetControlReference (ch
);
2008 DisposeWindow (window_ptr
);
2013 static char * button_names
[] = {
2014 "button1", "button2", "button3", "button4", "button5",
2015 "button6", "button7", "button8", "button9", "button10" };
2018 mac_dialog_show (f
, keymaps
, title
, error
)
2024 int i
, nb_buttons
=0;
2025 char dialog_name
[6];
2026 int menu_item_selection
;
2028 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2030 /* Number of elements seen so far, before boundary. */
2032 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2033 int boundary_seen
= 0;
2037 if (menu_items_n_panes
> 1)
2039 *error
= "Multiple panes in dialog box";
2043 /* Create a tree of widget_value objects
2044 representing the text label and buttons. */
2046 Lisp_Object pane_name
, prefix
;
2048 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2049 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2050 pane_string
= (NILP (pane_name
)
2051 ? "" : (char *) SDATA (pane_name
));
2052 prev_wv
= xmalloc_widget_value ();
2053 prev_wv
->value
= pane_string
;
2054 if (keymaps
&& !NILP (prefix
))
2056 prev_wv
->enabled
= 1;
2057 prev_wv
->name
= "message";
2058 prev_wv
->help
= Qnil
;
2061 /* Loop over all panes and items, filling in the tree. */
2062 i
= MENU_ITEMS_PANE_LENGTH
;
2063 while (i
< menu_items_used
)
2066 /* Create a new item within current pane. */
2067 Lisp_Object item_name
, enable
, descrip
, help
;
2069 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2070 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2072 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2073 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2075 if (NILP (item_name
))
2077 free_menubar_widget_value_tree (first_wv
);
2078 *error
= "Submenu in dialog items";
2081 if (EQ (item_name
, Qquote
))
2083 /* This is the boundary between left-side elts
2084 and right-side elts. Stop incrementing right_count. */
2089 if (nb_buttons
>= 9)
2091 free_menubar_widget_value_tree (first_wv
);
2092 *error
= "Too many dialog items";
2096 wv
= xmalloc_widget_value ();
2098 wv
->name
= (char *) button_names
[nb_buttons
];
2099 if (!NILP (descrip
))
2100 wv
->key
= (char *) SDATA (descrip
);
2101 wv
->value
= (char *) SDATA (item_name
);
2102 wv
->call_data
= (void *) i
;
2103 /* menu item is identified by its index in menu_items table */
2104 wv
->enabled
= !NILP (enable
);
2108 if (! boundary_seen
)
2112 i
+= MENU_ITEMS_ITEM_LENGTH
;
2115 /* If the boundary was not specified,
2116 by default put half on the left and half on the right. */
2117 if (! boundary_seen
)
2118 left_count
= nb_buttons
- nb_buttons
/ 2;
2120 wv
= xmalloc_widget_value ();
2121 wv
->name
= dialog_name
;
2124 /* Dialog boxes use a really stupid name encoding
2125 which specifies how many buttons to use
2126 and how many buttons are on the right.
2127 The Q means something also. */
2128 dialog_name
[0] = 'Q';
2129 dialog_name
[1] = '0' + nb_buttons
;
2130 dialog_name
[2] = 'B';
2131 dialog_name
[3] = 'R';
2132 /* Number of buttons to put on the right. */
2133 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2135 wv
->contents
= first_wv
;
2139 /* Actually create the dialog. */
2141 menu_item_selection
= mac_dialog (first_wv
);
2143 menu_item_selection
= 0;
2146 /* Free the widget_value objects we used to specify the contents. */
2147 free_menubar_widget_value_tree (first_wv
);
2149 /* Find the selected item, and its pane, to return the proper
2151 if (menu_item_selection
!= 0)
2157 while (i
< menu_items_used
)
2161 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2164 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2165 i
+= MENU_ITEMS_PANE_LENGTH
;
2170 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2171 if (menu_item_selection
== i
)
2175 entry
= Fcons (entry
, Qnil
);
2177 entry
= Fcons (prefix
, entry
);
2181 i
+= MENU_ITEMS_ITEM_LENGTH
;
2188 #endif /* HAVE_DIALOGS */
2191 /* Is this item a separator? */
2193 name_is_separator (name
)
2198 /* Check if name string consists of only dashes ('-'). */
2199 while (*name
== '-') name
++;
2200 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2201 or "--deep-shadow". We don't implement them yet, se we just treat
2202 them like normal separators. */
2203 return (*name
== '\0' || start
+ 2 == name
);
2207 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
,
2213 if (name_is_separator (wv
->name
))
2214 AppendMenu (menu
, "\p-");
2217 AppendMenu (menu
, "\pX");
2219 #if TARGET_API_MAC_CARBON
2220 pos
= CountMenuItems (menu
);
2222 pos
= CountMItems (menu
);
2225 strcpy (item_name
, "");
2226 strncat (item_name
, wv
->name
, 255);
2227 if (wv
->key
!= NULL
)
2229 strncat (item_name
, " ", 255);
2230 strncat (item_name
, wv
->key
, 255);
2234 SetMenuItemText (menu
, pos
, item_name
);
2236 if (wv
->enabled
&& !force_disable
)
2237 #if TARGET_API_MAC_CARBON
2238 EnableMenuItem (menu
, pos
);
2240 EnableItem (menu
, pos
);
2243 #if TARGET_API_MAC_CARBON
2244 DisableMenuItem (menu
, pos
);
2246 DisableItem (menu
, pos
);
2249 /* Draw radio buttons and tickboxes. */
2251 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2252 wv
->button_type
== BUTTON_TYPE_RADIO
))
2253 SetItemMark (menu
, pos
, checkMark
);
2255 SetItemMark (menu
, pos
, noMark
);
2259 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2261 if (submenu
!= NULL
)
2262 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2265 /* Construct native Mac OS menubar based on widget_value tree. */
2268 fill_submenu (MenuHandle menu
, widget_value
*wv
)
2270 for ( ; wv
!= NULL
; wv
= wv
->next
)
2273 int cur_submenu
= submenu_id
++;
2274 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2275 fill_submenu (submenu
, wv
->contents
);
2276 InsertMenu (submenu
, -1);
2277 add_menu_item (menu
, wv
, cur_submenu
, 0);
2280 add_menu_item (menu
, wv
, NULL
, 0);
2284 /* Construct native Mac OS menu based on widget_value tree. */
2287 fill_menu (MenuHandle menu
, widget_value
*wv
)
2289 for ( ; wv
!= NULL
; wv
= wv
->next
)
2292 int cur_submenu
= submenu_id
++;
2293 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2294 fill_submenu (submenu
, wv
->contents
);
2295 InsertMenu (submenu
, -1);
2296 add_menu_item (menu
, wv
, cur_submenu
, 0);
2299 add_menu_item (menu
, wv
, NULL
, 0);
2302 /* Construct native Mac OS menubar based on widget_value tree. */
2305 fill_menubar (widget_value
*wv
)
2309 submenu_id
= MIN_SUBMENU_ID
;
2311 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2316 strncpy (title
, wv
->name
, 255);
2319 menu
= NewMenu (id
, title
);
2322 fill_menu (menu
, wv
->contents
);
2324 InsertMenu (menu
, 0);
2328 #endif /* HAVE_MENUS */
2334 staticpro (&menu_items
);
2337 Qdebug_on_next_call
= intern ("debug-on-next-call");
2338 staticpro (&Qdebug_on_next_call
);
2340 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2341 doc
: /* Frame for which we are updating a menu.
2342 The enable predicate for a menu command should check this variable. */);
2343 Vmenu_updating_frame
= Qnil
;
2345 defsubr (&Sx_popup_menu
);
2347 defsubr (&Sx_popup_dialog
);
2351 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2352 (do not change this comment) */