1 /* Menu support for GNU Emacs on the for Mac OS.
2 Copyright (C) 2000, 2001, 2002 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"
45 /* Macros max and min defined in lisp.h conflict with those in
46 precompiled header Carbon.h. */
49 #include <Carbon/Carbon.h>
51 #define Z (current_buffer->text->z)
53 #define free unexec_free
55 #define malloc unexec_malloc
57 #define realloc unexec_realloc
59 #define min(a, b) ((a) < (b) ? (a) : (b))
61 #define max(a, b) ((a) > (b) ? (a) : (b))
62 #else /* not MAC_OSX */
65 #include <QuickDraw.h>
66 #include <ToolUtils.h>
71 #if defined (__MRC__) || (__MSL__ >= 0x6000)
72 #include <ControlDefinitions.h>
74 #endif /* not MAC_OSX */
76 /* This may include sys/types.h, and that somehow loses
77 if this is not done before the other system files. */
80 /* Load sys/types.h if not already loaded.
81 In some systems loading it twice is suicidal. */
83 #include <sys/types.h>
86 #include "dispextern.h"
88 #define POPUP_SUBMENU_ID 235
89 #define MIN_MENU_ID 256
90 #define MIN_SUBMENU_ID 1
92 #define DIALOG_WINDOW_RESOURCE 130
94 #define HAVE_DIALOGS 1
96 #undef HAVE_MULTILINGUAL_MENU
97 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
99 /******************************************************************/
100 /* Definitions copied from lwlib.h */
102 typedef void * XtPointer
;
111 /* This structure is based on the one in ../lwlib/lwlib.h, modified
113 typedef struct _widget_value
117 /* value (meaning depend on widget type) */
119 /* keyboard equivalent. no implications for XtTranslations */
121 /* Help string or nil if none.
122 GC finds this string through the frame's menu_bar_vector
123 or through menu_items. */
125 /* true if enabled */
127 /* true if selected */
129 /* The type of a button. */
130 enum button_type button_type
;
131 /* true if menu title */
134 /* true if was edited (maintained by get_value) */
136 /* true if has changed (maintained by lw library) */
138 /* true if this widget itself has changed,
139 but not counting the other widgets found in the `next' field. */
140 change_type this_one_change
;
142 /* Contents of the sub-widgets, also selected slot for checkbox */
143 struct _widget_value
* contents
;
144 /* data passed to callback */
146 /* next one in the list */
147 struct _widget_value
* next
;
149 /* slot for the toolkit dependent part. Always initialize to NULL. */
151 /* tell us if we should free the toolkit data slot when freeing the
152 widget_value itself. */
153 Boolean free_toolkit_data
;
155 /* we resource the widget_value structures; this points to the next
156 one on the free list if this one has been deallocated.
158 struct _widget_value
*free_list
;
162 /* Assumed by other routines to zero area returned. */
163 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
164 0, (sizeof (widget_value)))
165 #define free_widget_value(wv) xfree (wv)
167 /******************************************************************/
174 Lisp_Object Vmenu_updating_frame
;
176 Lisp_Object Qdebug_on_next_call
;
178 extern Lisp_Object Qmenu_bar
;
179 extern Lisp_Object Qmouse_click
, Qevent_kind
;
181 extern Lisp_Object QCtoggle
, QCradio
;
183 extern Lisp_Object Voverriding_local_map
;
184 extern Lisp_Object Voverriding_local_map_menu_flag
;
186 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
188 extern Lisp_Object Qmenu_bar_update_hook
;
190 void set_frame_menubar ();
192 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
193 Lisp_Object
, Lisp_Object
, Lisp_Object
,
194 Lisp_Object
, Lisp_Object
));
196 static Lisp_Object
mac_dialog_show ();
198 static Lisp_Object
mac_menu_show ();
200 static void keymap_panes ();
201 static void single_keymap_panes ();
202 static void single_menu_item ();
203 static void list_of_panes ();
204 static void list_of_items ();
206 static void fill_submenu (MenuHandle
, widget_value
*, int);
207 static void fill_menubar (widget_value
*);
210 /* This holds a Lisp vector that holds the results of decoding
211 the keymaps or alist-of-alists that specify a menu.
213 It describes the panes and items within the panes.
215 Each pane is described by 3 elements in the vector:
216 t, the pane name, the pane's prefix key.
217 Then follow the pane's items, with 5 elements per item:
218 the item string, the enable flag, the item's value,
219 the definition, and the equivalent keyboard key's description string.
221 In some cases, multiple levels of menus may be described.
222 A single vector slot containing nil indicates the start of a submenu.
223 A single vector slot containing lambda indicates the end of a submenu.
224 The submenu follows a menu item which is the way to reach the submenu.
226 A single vector slot containing quote indicates that the
227 following items should appear on the right of a dialog box.
229 Using a Lisp vector to hold this information while we decode it
230 takes care of protecting all the data from GC. */
232 #define MENU_ITEMS_PANE_NAME 1
233 #define MENU_ITEMS_PANE_PREFIX 2
234 #define MENU_ITEMS_PANE_LENGTH 3
238 MENU_ITEMS_ITEM_NAME
= 0,
239 MENU_ITEMS_ITEM_ENABLE
,
240 MENU_ITEMS_ITEM_VALUE
,
241 MENU_ITEMS_ITEM_EQUIV_KEY
,
242 MENU_ITEMS_ITEM_DEFINITION
,
243 MENU_ITEMS_ITEM_TYPE
,
244 MENU_ITEMS_ITEM_SELECTED
,
245 MENU_ITEMS_ITEM_HELP
,
246 MENU_ITEMS_ITEM_LENGTH
249 static Lisp_Object menu_items
;
251 /* Number of slots currently allocated in menu_items. */
252 static int menu_items_allocated
;
254 /* This is the index in menu_items of the first empty slot. */
255 static int menu_items_used
;
257 /* The number of panes currently recorded in menu_items,
258 excluding those within submenus. */
259 static int menu_items_n_panes
;
261 /* Current depth within submenus. */
262 static int menu_items_submenu_depth
;
264 /* Flag which when set indicates a dialog or menu has been posted by
265 Xt on behalf of one of the widget sets. */
266 static int popup_activated_flag
;
268 static int next_menubar_widget_id
;
270 /* This is set nonzero after the user activates the menu bar, and set
271 to zero again after the menu bars are redisplayed by prepare_menu_bar.
272 While it is nonzero, all calls to set_frame_menubar go deep.
274 I don't understand why this is needed, but it does seem to be
275 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
277 int pending_menu_activation
;
279 /* Initialize the menu_items structure if we haven't already done so.
280 Also mark it as currently empty. */
285 if (NILP (menu_items
))
287 menu_items_allocated
= 60;
288 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
292 menu_items_n_panes
= 0;
293 menu_items_submenu_depth
= 0;
296 /* Call at the end of generating the data in menu_items.
297 This fills in the number of items in the last pane. */
304 /* Call when finished using the data for the current menu
308 discard_menu_items ()
310 /* Free the structure if it is especially large.
311 Otherwise, hold on to it, to save time. */
312 if (menu_items_allocated
> 200)
315 menu_items_allocated
= 0;
319 /* Make the menu_items vector twice as large. */
325 int old_size
= menu_items_allocated
;
328 menu_items_allocated
*= 2;
329 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
330 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
331 old_size
* sizeof (Lisp_Object
));
334 /* Begin a submenu. */
337 push_submenu_start ()
339 if (menu_items_used
+ 1 > menu_items_allocated
)
342 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
343 menu_items_submenu_depth
++;
351 if (menu_items_used
+ 1 > menu_items_allocated
)
354 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
355 menu_items_submenu_depth
--;
358 /* Indicate boundary between left and right. */
361 push_left_right_boundary ()
363 if (menu_items_used
+ 1 > menu_items_allocated
)
366 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
369 /* Start a new menu pane in menu_items.
370 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
373 push_menu_pane (name
, prefix_vec
)
374 Lisp_Object name
, prefix_vec
;
376 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
379 if (menu_items_submenu_depth
== 0)
380 menu_items_n_panes
++;
381 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
382 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
383 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
386 /* Push one menu item into the current pane. NAME is the string to
387 display. ENABLE if non-nil means this item can be selected. KEY
388 is the key generated by choosing this item, or nil if this item
389 doesn't really have a definition. DEF is the definition of this
390 item. EQUIV is the textual description of the keyboard equivalent
391 for this item (or nil if none). TYPE is the type of this menu
392 item, one of nil, `toggle' or `radio'. */
395 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
396 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
398 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
401 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
402 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
403 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
404 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
405 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
406 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
407 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
408 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
411 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
412 and generate menu panes for them in menu_items.
413 If NOTREAL is nonzero,
414 don't bother really computing whether an item is enabled. */
417 keymap_panes (keymaps
, nmaps
, notreal
)
418 Lisp_Object
*keymaps
;
426 /* Loop over the given keymaps, making a pane for each map.
427 But don't make a pane that is empty--ignore that map instead.
428 P is the number of panes we have made so far. */
429 for (mapno
= 0; mapno
< nmaps
; mapno
++)
430 single_keymap_panes (keymaps
[mapno
],
431 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
433 finish_menu_items ();
436 /* This is a recursive subroutine of keymap_panes.
437 It handles one keymap, KEYMAP.
438 The other arguments are passed along
439 or point to local variables of the previous function.
440 If NOTREAL is nonzero, only check for equivalent key bindings, don't
441 evaluate expressions in menu items and don't make any menu.
443 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
446 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
448 Lisp_Object pane_name
;
453 Lisp_Object pending_maps
= Qnil
;
454 Lisp_Object tail
, item
;
455 struct gcpro gcpro1
, gcpro2
;
460 push_menu_pane (pane_name
, prefix
);
462 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
464 GCPRO2 (keymap
, pending_maps
);
465 /* Look at each key binding, and if it is a menu item add it
469 single_menu_item (XCAR (item
), XCDR (item
),
470 &pending_maps
, notreal
, maxdepth
);
471 else if (VECTORP (item
))
473 /* Loop over the char values represented in the vector. */
474 int len
= XVECTOR (item
)->size
;
476 for (c
= 0; c
< len
; c
++)
478 Lisp_Object character
;
479 XSETFASTINT (character
, c
);
480 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
481 &pending_maps
, notreal
, maxdepth
);
487 /* Process now any submenus which want to be panes at this level. */
488 while (!NILP (pending_maps
))
490 Lisp_Object elt
, eltcdr
, string
;
491 elt
= Fcar (pending_maps
);
493 string
= XCAR (eltcdr
);
494 /* We no longer discard the @ from the beginning of the string here.
495 Instead, we do this in mac_menu_show. */
496 single_keymap_panes (Fcar (elt
), string
,
497 XCDR (eltcdr
), notreal
, maxdepth
- 1);
498 pending_maps
= Fcdr (pending_maps
);
502 /* This is a subroutine of single_keymap_panes that handles one
504 KEY is a key in a keymap and ITEM is its binding.
505 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
507 If NOTREAL is nonzero, only check for equivalent key bindings, don't
508 evaluate expressions in menu items and don't make any menu.
509 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
512 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
513 Lisp_Object key
, item
;
514 Lisp_Object
*pending_maps_ptr
;
515 int maxdepth
, notreal
;
517 Lisp_Object map
, item_string
, enabled
;
518 struct gcpro gcpro1
, gcpro2
;
521 /* Parse the menu item and leave the result in item_properties. */
523 res
= parse_menu_item (item
, notreal
, 0);
526 return; /* Not a menu item. */
528 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
532 /* We don't want to make a menu, just traverse the keymaps to
533 precompute equivalent key bindings. */
535 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
539 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
540 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
542 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
545 /* An enabled separate pane. Remember this to handle it later. */
546 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
551 push_menu_item (item_string
, enabled
, key
,
552 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
553 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
554 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
555 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
556 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
558 /* Display a submenu using the toolkit. */
559 if (! (NILP (map
) || NILP (enabled
)))
561 push_submenu_start ();
562 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
567 /* Push all the panes and items of a menu described by the
568 alist-of-alists MENU.
569 This handles old-fashioned calls to x-popup-menu. */
579 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
581 Lisp_Object elt
, pane_name
, pane_data
;
583 pane_name
= Fcar (elt
);
584 CHECK_STRING (pane_name
);
585 push_menu_pane (pane_name
, Qnil
);
586 pane_data
= Fcdr (elt
);
587 CHECK_CONS (pane_data
);
588 list_of_items (pane_data
);
591 finish_menu_items ();
594 /* Push the items in a single pane defined by the alist PANE. */
600 Lisp_Object tail
, item
, item1
;
602 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
606 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
607 else if (NILP (item
))
608 push_left_right_boundary ();
613 CHECK_STRING (item1
);
614 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
619 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
620 doc
: /* Pop up a deck-of-cards menu and return user's selection.
621 POSITION is a position specification. This is either a mouse button
622 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
623 are positions in pixels from the top left corner of WINDOW's frame
624 \(WINDOW may be a frame object instead of a window). This controls the
625 position of the center of the first line in the first pane of the
626 menu, not the top left of the menu as a whole. If POSITION is t, it
627 means to use the current mouse position.
629 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
630 The menu items come from key bindings that have a menu string as well as
631 a definition; actually, the \"definition\" in such a key binding looks like
632 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
633 the keymap as a top-level element.
635 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
636 Otherwise, REAL-DEFINITION should be a valid key binding definition.
638 You can also use a list of keymaps as MENU. Then each keymap makes a
639 separate pane. When MENU is a keymap or a list of keymaps, the return
640 value is a list of events.
642 Alternatively, you can specify a menu of multiple panes with a list of
643 the form (TITLE PANE1 PANE2...), where each pane is a list of
644 form (TITLE ITEM1 ITEM2...).
645 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
646 appear as an item--that makes a nonselectable line in the menu.
647 With this form of menu, the return value is VALUE from the chosen item.
649 If POSITION is nil, don't display the menu at all, just precalculate the
650 cached information about equivalent key sequences. */)
652 Lisp_Object position
, menu
;
654 Lisp_Object keymap
, tem
;
655 int xpos
= 0, ypos
= 0;
658 Lisp_Object selection
;
660 Lisp_Object x
, y
, window
;
666 if (! NILP (position
))
670 /* Decode the first argument: find the window and the coordinates. */
671 if (EQ (position
, Qt
)
672 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
673 || EQ (XCAR (position
), Qtool_bar
))))
675 /* Use the mouse's current position. */
676 FRAME_PTR new_f
= SELECTED_FRAME ();
677 Lisp_Object bar_window
;
678 enum scroll_bar_part part
;
681 if (mouse_position_hook
)
682 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
683 &part
, &x
, &y
, &time
);
685 XSETFRAME (window
, new_f
);
688 window
= selected_window
;
695 tem
= Fcar (position
);
698 window
= Fcar (Fcdr (position
));
700 y
= Fcar (Fcdr (tem
));
705 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
706 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
707 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
716 /* Decode where to put the menu. */
724 else if (WINDOWP (window
))
726 CHECK_LIVE_WINDOW (window
);
727 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
729 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
730 * XFASTINT (XWINDOW (window
)->left
));
731 ypos
= (FRAME_LINE_HEIGHT (f
)
732 * XFASTINT (XWINDOW (window
)->top
));
735 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
736 but I don't want to make one now. */
737 CHECK_WINDOW (window
);
742 XSETFRAME (Vmenu_updating_frame
, f
);
744 Vmenu_updating_frame
= Qnil
;
745 #endif /* HAVE_MENUS */
750 /* Decode the menu items from what was specified. */
752 keymap
= get_keymap (menu
, 0, 0);
755 /* We were given a keymap. Extract menu info from the keymap. */
758 /* Extract the detailed info to make one pane. */
759 keymap_panes (&menu
, 1, NILP (position
));
761 /* Search for a string appearing directly as an element of the keymap.
762 That string is the title of the menu. */
763 prompt
= Fkeymap_prompt (keymap
);
764 if (NILP (title
) && !NILP (prompt
))
767 /* Make that be the pane title of the first pane. */
768 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
769 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
773 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
775 /* We were given a list of keymaps. */
776 int nmaps
= XFASTINT (Flength (menu
));
778 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
783 /* The first keymap that has a prompt string
784 supplies the menu title. */
785 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
789 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
791 prompt
= Fkeymap_prompt (keymap
);
792 if (NILP (title
) && !NILP (prompt
))
796 /* Extract the detailed info to make one pane. */
797 keymap_panes (maps
, nmaps
, NILP (position
));
799 /* Make the title be the pane title of the first pane. */
800 if (!NILP (title
) && menu_items_n_panes
>= 0)
801 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
807 /* We were given an old-fashioned menu. */
809 CHECK_STRING (title
);
811 list_of_panes (Fcdr (menu
));
818 discard_menu_items ();
824 /* Display them in a menu. */
827 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
828 keymaps
, title
, &error_name
);
831 discard_menu_items ();
834 #endif /* HAVE_MENUS */
836 if (error_name
) error (error_name
);
842 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
843 doc
: /* Pop up a dialog box and return user's selection.
844 POSITION specifies which frame to use.
845 This is normally a mouse button event or a window or frame.
846 If POSITION is t, it means to use the frame the mouse is on.
847 The dialog box appears in the middle of the specified frame.
849 CONTENTS specifies the alternatives to display in the dialog box.
850 It is a list of the form (TITLE ITEM1 ITEM2...).
851 Each ITEM is a cons cell (STRING . VALUE).
852 The return value is VALUE from the chosen item.
854 An ITEM may also be just a string--that makes a nonselectable item.
855 An ITEM may also be nil--that means to put all preceding items
856 on the left of the dialog box and all following items on the right.
857 \(By default, approximately half appear on each side.) */)
859 Lisp_Object position
, contents
;
866 /* Decode the first argument: find the window or frame to use. */
867 if (EQ (position
, Qt
)
868 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
869 || EQ (XCAR (position
), Qtool_bar
))))
871 #if 0 /* Using the frame the mouse is on may not be right. */
872 /* Use the mouse's current position. */
873 FRAME_PTR new_f
= SELECTED_FRAME ();
874 Lisp_Object bar_window
;
875 enum scroll_bar_part part
;
879 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
882 XSETFRAME (window
, new_f
);
884 window
= selected_window
;
886 window
= selected_window
;
888 else if (CONSP (position
))
891 tem
= Fcar (position
);
893 window
= Fcar (Fcdr (position
));
896 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
897 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
900 else if (WINDOWP (position
) || FRAMEP (position
))
905 /* Decode where to put the menu. */
909 else if (WINDOWP (window
))
911 CHECK_LIVE_WINDOW (window
);
912 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
915 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
916 but I don't want to make one now. */
917 CHECK_WINDOW (window
);
920 /* Display a menu with these alternatives
921 in the middle of frame F. */
923 Lisp_Object x
, y
, frame
, newpos
;
924 XSETFRAME (frame
, f
);
925 XSETINT (x
, x_pixel_width (f
) / 2);
926 XSETINT (y
, x_pixel_height (f
) / 2);
927 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
929 return Fx_popup_menu (newpos
,
930 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
932 #else /* HAVE_DIALOGS */
936 Lisp_Object selection
;
938 /* Decode the dialog items from what was specified. */
939 title
= Fcar (contents
);
940 CHECK_STRING (title
);
942 list_of_panes (Fcons (contents
, Qnil
));
944 /* Display them in a dialog box. */
946 selection
= mac_dialog_show (f
, 0, title
, &error_name
);
949 discard_menu_items ();
951 if (error_name
) error (error_name
);
954 #endif /* HAVE_DIALOGS */
957 /* Activate the menu bar of frame F.
958 This is called from keyboard.c when it gets the
959 menu_bar_activate_event out of the Emacs event queue.
961 To activate the menu bar, we signal to the input thread that it can
962 return from the WM_INITMENU message, allowing the normal Windows
963 processing of the menus.
965 But first we recompute the menu bar contents (the whole tree).
967 This way we can safely execute Lisp code. */
970 x_activate_menubar (f
)
974 extern Point saved_menu_event_location
;
976 set_frame_menubar (f
, 0, 1);
979 menu_choice
= MenuSelect (saved_menu_event_location
);
980 do_menu_choice (menu_choice
);
985 /* This callback is called from the menu bar pulldown menu
986 when the user makes a selection.
987 Figure out what the user chose
988 and put the appropriate events into the keyboard buffer. */
991 menubar_selection_callback (FRAME_PTR f
, int client_data
)
993 Lisp_Object prefix
, entry
;
995 Lisp_Object
*subprefix_stack
;
996 int submenu_depth
= 0;
1002 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1003 vector
= f
->menu_bar_vector
;
1006 while (i
< f
->menu_bar_items_used
)
1008 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1010 subprefix_stack
[submenu_depth
++] = prefix
;
1014 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1016 prefix
= subprefix_stack
[--submenu_depth
];
1019 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1021 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1022 i
+= MENU_ITEMS_PANE_LENGTH
;
1026 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1027 /* The EMACS_INT cast avoids a warning. There's no problem
1028 as long as pointers have enough bits to hold small integers. */
1029 if ((int) (EMACS_INT
) client_data
== i
)
1032 struct input_event buf
;
1035 XSETFRAME (frame
, f
);
1036 buf
.kind
= MENU_BAR_EVENT
;
1037 buf
.frame_or_window
= frame
;
1039 kbd_buffer_store_event (&buf
);
1041 for (j
= 0; j
< submenu_depth
; j
++)
1042 if (!NILP (subprefix_stack
[j
]))
1044 buf
.kind
= MENU_BAR_EVENT
;
1045 buf
.frame_or_window
= frame
;
1046 buf
.arg
= subprefix_stack
[j
];
1047 kbd_buffer_store_event (&buf
);
1052 buf
.kind
= MENU_BAR_EVENT
;
1053 buf
.frame_or_window
= frame
;
1055 kbd_buffer_store_event (&buf
);
1058 buf
.kind
= MENU_BAR_EVENT
;
1059 buf
.frame_or_window
= frame
;
1061 kbd_buffer_store_event (&buf
);
1063 f
->output_data
.mac
->menu_command_in_progress
= 0;
1064 f
->output_data
.mac
->menubar_active
= 0;
1067 i
+= MENU_ITEMS_ITEM_LENGTH
;
1070 f
->output_data
.mac
->menu_command_in_progress
= 0;
1071 f
->output_data
.mac
->menubar_active
= 0;
1074 /* Allocate a widget_value, blocking input. */
1077 xmalloc_widget_value ()
1079 widget_value
*value
;
1082 value
= malloc_widget_value ();
1088 /* This recursively calls free_widget_value on the tree of widgets.
1089 It must free all data that was malloc'ed for these widget_values.
1090 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1091 must be left alone. */
1094 free_menubar_widget_value_tree (wv
)
1099 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1101 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1103 free_menubar_widget_value_tree (wv
->contents
);
1104 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1108 free_menubar_widget_value_tree (wv
->next
);
1109 wv
->next
= (widget_value
*) 0xDEADBEEF;
1112 free_widget_value (wv
);
1116 /* Return a tree of widget_value structures for a menu bar item
1117 whose event type is ITEM_KEY (with string ITEM_NAME)
1118 and whose contents come from the list of keymaps MAPS. */
1120 static widget_value
*
1121 single_submenu (item_key
, item_name
, maps
)
1122 Lisp_Object item_key
, item_name
, maps
;
1124 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1126 int submenu_depth
= 0;
1129 Lisp_Object
*mapvec
;
1130 widget_value
**submenu_stack
;
1131 int previous_items
= menu_items_used
;
1132 int top_level_items
= 0;
1134 length
= Flength (maps
);
1135 len
= XINT (length
);
1137 /* Convert the list MAPS into a vector MAPVEC. */
1138 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1139 for (i
= 0; i
< len
; i
++)
1141 mapvec
[i
] = Fcar (maps
);
1145 menu_items_n_panes
= 0;
1147 /* Loop over the given keymaps, making a pane for each map.
1148 But don't make a pane that is empty--ignore that map instead. */
1149 for (i
= 0; i
< len
; i
++)
1151 if (SYMBOLP (mapvec
[i
])
1152 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1154 /* Here we have a command at top level in the menu bar
1155 as opposed to a submenu. */
1156 top_level_items
= 1;
1157 push_menu_pane (Qnil
, Qnil
);
1158 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1159 Qnil
, Qnil
, Qnil
, Qnil
);
1162 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1165 /* Create a tree of widget_value objects
1166 representing the panes and their items. */
1169 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1170 wv
= xmalloc_widget_value ();
1174 wv
->button_type
= BUTTON_TYPE_NONE
;
1180 /* Loop over all panes and items made during this call
1181 and construct a tree of widget_value objects.
1182 Ignore the panes and items made by previous calls to
1183 single_submenu, even though those are also in menu_items. */
1185 while (i
< menu_items_used
)
1187 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1189 submenu_stack
[submenu_depth
++] = save_wv
;
1194 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1197 save_wv
= submenu_stack
[--submenu_depth
];
1200 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1201 && submenu_depth
!= 0)
1202 i
+= MENU_ITEMS_PANE_LENGTH
;
1203 /* Ignore a nil in the item list.
1204 It's meaningful only for dialog boxes. */
1205 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1207 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1209 /* Create a new pane. */
1210 Lisp_Object pane_name
, prefix
;
1213 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1214 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1216 #ifndef HAVE_MULTILINGUAL_MENU
1217 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1219 pane_name
= ENCODE_SYSTEM (pane_name
);
1220 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1223 pane_string
= (NILP (pane_name
)
1224 ? "" : (char *) XSTRING (pane_name
)->data
);
1225 /* If there is just one top-level pane, put all its items directly
1226 under the top-level menu. */
1227 if (menu_items_n_panes
== 1)
1230 /* If the pane has a meaningful name,
1231 make the pane a top-level menu item
1232 with its items as a submenu beneath it. */
1233 if (strcmp (pane_string
, ""))
1235 wv
= xmalloc_widget_value ();
1239 first_wv
->contents
= wv
;
1240 wv
->name
= pane_string
;
1241 /* Ignore the @ that means "separate pane".
1242 This is a kludge, but this isn't worth more time. */
1243 if (!NILP (prefix
) && wv
->name
[0] == '@')
1247 wv
->button_type
= BUTTON_TYPE_NONE
;
1252 i
+= MENU_ITEMS_PANE_LENGTH
;
1256 /* Create a new item within current pane. */
1257 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1260 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1261 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1262 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1263 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1264 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1265 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1266 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1268 #ifndef HAVE_MULTILINGUAL_MENU
1269 if (STRING_MULTIBYTE (item_name
))
1271 item_name
= ENCODE_SYSTEM (item_name
);
1272 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1275 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1277 descrip
= ENCODE_SYSTEM (descrip
);
1278 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1280 #endif /* not HAVE_MULTILINGUAL_MENU */
1282 wv
= xmalloc_widget_value ();
1286 save_wv
->contents
= wv
;
1288 wv
->name
= (char *) XSTRING (item_name
)->data
;
1289 if (!NILP (descrip
))
1290 wv
->key
= (char *) XSTRING (descrip
)->data
;
1292 /* The EMACS_INT cast avoids a warning. There's no problem
1293 as long as pointers have enough bits to hold small integers. */
1294 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1295 wv
->enabled
= !NILP (enable
);
1298 wv
->button_type
= BUTTON_TYPE_NONE
;
1299 else if (EQ (type
, QCradio
))
1300 wv
->button_type
= BUTTON_TYPE_RADIO
;
1301 else if (EQ (type
, QCtoggle
))
1302 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1306 wv
->selected
= !NILP (selected
);
1307 if (!STRINGP (help
))
1314 i
+= MENU_ITEMS_ITEM_LENGTH
;
1318 /* If we have just one "menu item"
1319 that was originally a button, return it by itself. */
1320 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1322 wv
= first_wv
->contents
;
1323 free_widget_value (first_wv
);
1330 /* Set the contents of the menubar widgets of frame F.
1331 The argument FIRST_TIME is currently ignored;
1332 it is set the first time this is called, from initialize_frame_menubar. */
1335 set_frame_menubar (f
, first_time
, deep_p
)
1340 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1342 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1345 /* We must not change the menubar when actually in use. */
1346 if (f
->output_data
.mac
->menubar_active
)
1349 XSETFRAME (Vmenu_updating_frame
, f
);
1351 if (! menubar_widget
)
1353 else if (pending_menu_activation
&& !deep_p
)
1356 wv
= xmalloc_widget_value ();
1357 wv
->name
= "menubar";
1360 wv
->button_type
= BUTTON_TYPE_NONE
;
1366 /* Make a widget-value tree representing the entire menu trees. */
1368 struct buffer
*prev
= current_buffer
;
1370 int specpdl_count
= specpdl_ptr
- specpdl
;
1371 int previous_menu_items_used
= f
->menu_bar_items_used
;
1372 Lisp_Object
*previous_items
1373 = (Lisp_Object
*) alloca (previous_menu_items_used
1374 * sizeof (Lisp_Object
));
1376 /* If we are making a new widget, its contents are empty,
1377 do always reinitialize them. */
1378 if (! menubar_widget
)
1379 previous_menu_items_used
= 0;
1381 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1382 specbind (Qinhibit_quit
, Qt
);
1383 /* Don't let the debugger step into this code
1384 because it is not reentrant. */
1385 specbind (Qdebug_on_next_call
, Qnil
);
1387 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1388 if (NILP (Voverriding_local_map_menu_flag
))
1390 specbind (Qoverriding_terminal_local_map
, Qnil
);
1391 specbind (Qoverriding_local_map
, Qnil
);
1394 set_buffer_internal_1 (XBUFFER (buffer
));
1396 /* Run the Lucid hook. */
1397 safe_run_hooks (Qactivate_menubar_hook
);
1398 /* If it has changed current-menubar from previous value,
1399 really recompute the menubar from the value. */
1400 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1401 call0 (Qrecompute_lucid_menubar
);
1402 safe_run_hooks (Qmenu_bar_update_hook
);
1403 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1405 items
= FRAME_MENU_BAR_ITEMS (f
);
1407 inhibit_garbage_collection ();
1409 /* Save the frame's previous menu bar contents data. */
1410 if (previous_menu_items_used
)
1411 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1412 previous_menu_items_used
* sizeof (Lisp_Object
));
1414 /* Fill in the current menu bar contents. */
1415 menu_items
= f
->menu_bar_vector
;
1416 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1418 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1420 Lisp_Object key
, string
, maps
;
1422 key
= XVECTOR (items
)->contents
[i
];
1423 string
= XVECTOR (items
)->contents
[i
+ 1];
1424 maps
= XVECTOR (items
)->contents
[i
+ 2];
1428 wv
= single_submenu (key
, string
, maps
);
1432 first_wv
->contents
= wv
;
1433 /* Don't set wv->name here; GC during the loop might relocate it. */
1435 wv
->button_type
= BUTTON_TYPE_NONE
;
1439 finish_menu_items ();
1441 set_buffer_internal_1 (prev
);
1442 unbind_to (specpdl_count
, Qnil
);
1444 /* If there has been no change in the Lisp-level contents
1445 of the menu bar, skip redisplaying it. Just exit. */
1447 for (i
= 0; i
< previous_menu_items_used
; i
++)
1448 if (menu_items_used
== i
1449 || (!Fequal (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1451 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1453 free_menubar_widget_value_tree (first_wv
);
1459 /* Now GC cannot happen during the lifetime of the widget_value,
1460 so it's safe to store data from a Lisp_String, as long as
1461 local copies are made when the actual menu is created.
1462 Windows takes care of this for normal string items, but
1463 not for owner-drawn items or additional item-info. */
1464 wv
= first_wv
->contents
;
1465 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1468 string
= XVECTOR (items
)->contents
[i
+ 1];
1471 wv
->name
= (char *) XSTRING (string
)->data
;
1475 f
->menu_bar_vector
= menu_items
;
1476 f
->menu_bar_items_used
= menu_items_used
;
1481 /* Make a widget-value tree containing
1482 just the top level menu bar strings. */
1484 items
= FRAME_MENU_BAR_ITEMS (f
);
1485 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1489 string
= XVECTOR (items
)->contents
[i
+ 1];
1493 wv
= xmalloc_widget_value ();
1494 wv
->name
= (char *) XSTRING (string
)->data
;
1497 wv
->button_type
= BUTTON_TYPE_NONE
;
1499 /* This prevents lwlib from assuming this
1500 menu item is really supposed to be empty. */
1501 /* The EMACS_INT cast avoids a warning.
1502 This value just has to be different from small integers. */
1503 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1508 first_wv
->contents
= wv
;
1512 /* Forget what we thought we knew about what is in the
1513 detailed contents of the menu bar menus.
1514 Changing the top level always destroys the contents. */
1515 f
->menu_bar_items_used
= 0;
1518 /* Create or update the menu bar widget. */
1522 /* Non-null value to indicate menubar has already been "created". */
1523 f
->output_data
.mac
->menubar_widget
= 1;
1526 int i
= MIN_MENU_ID
;
1527 MenuHandle menu
= GetMenuHandle (i
);
1528 while (menu
!= NULL
)
1532 menu
= GetMenuHandle (++i
);
1536 menu
= GetMenuHandle (i
);
1537 while (menu
!= NULL
)
1541 menu
= GetMenuHandle (++i
);
1545 fill_menubar (first_wv
->contents
);
1549 free_menubar_widget_value_tree (first_wv
);
1554 /* Called from Fx_create_frame to create the initial menubar of a frame
1555 before it is mapped, so that the window is mapped with the menubar already
1556 there instead of us tacking it on later and thrashing the window after it
1560 initialize_frame_menubar (f
)
1563 /* This function is called before the first chance to redisplay
1564 the frame. It has to be, so the frame will have the right size. */
1565 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1566 set_frame_menubar (f
, 1, 1);
1569 /* Get rid of the menu bar of frame F, and free its storage.
1570 This is used when deleting a frame, and when turning off the menu bar. */
1573 free_frame_menubar (f
)
1576 f
->output_data
.mac
->menubar_widget
= NULL
;
1580 /* mac_menu_show actually displays a menu using the panes and items in
1581 menu_items and returns the value selected from it; we assume input
1582 is blocked by the caller. */
1584 /* F is the frame the menu is for.
1585 X and Y are the frame-relative specified position,
1586 relative to the inside upper left corner of the frame F.
1587 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1588 KEYMAPS is 1 if this menu was specified with keymaps;
1589 in that case, we return a list containing the chosen item's value
1590 and perhaps also the pane's prefix.
1591 TITLE is the specified menu title.
1592 ERROR is a place to store an error message string in case of failure.
1593 (We return nil on failure, but the value doesn't actually matter.) */
1596 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1606 int menu_item_selection
;
1609 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1610 widget_value
**submenu_stack
1611 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1612 Lisp_Object
*subprefix_stack
1613 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1614 int submenu_depth
= 0;
1619 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1621 *error
= "Empty menu";
1625 /* Create a tree of widget_value objects
1626 representing the panes and their items. */
1627 wv
= xmalloc_widget_value ();
1631 wv
->button_type
= BUTTON_TYPE_NONE
;
1636 /* Loop over all panes and items, filling in the tree. */
1638 while (i
< menu_items_used
)
1640 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1642 submenu_stack
[submenu_depth
++] = save_wv
;
1648 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1651 save_wv
= submenu_stack
[--submenu_depth
];
1655 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1656 && submenu_depth
!= 0)
1657 i
+= MENU_ITEMS_PANE_LENGTH
;
1658 /* Ignore a nil in the item list.
1659 It's meaningful only for dialog boxes. */
1660 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1662 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1664 /* Create a new pane. */
1665 Lisp_Object pane_name
, prefix
;
1667 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1668 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1669 #ifndef HAVE_MULTILINGUAL_MENU
1670 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1672 pane_name
= ENCODE_SYSTEM (pane_name
);
1673 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1676 pane_string
= (NILP (pane_name
)
1677 ? "" : (char *) XSTRING (pane_name
)->data
);
1678 /* If there is just one top-level pane, put all its items directly
1679 under the top-level menu. */
1680 if (menu_items_n_panes
== 1)
1683 /* If the pane has a meaningful name,
1684 make the pane a top-level menu item
1685 with its items as a submenu beneath it. */
1686 if (!keymaps
&& strcmp (pane_string
, ""))
1688 wv
= xmalloc_widget_value ();
1692 first_wv
->contents
= wv
;
1693 wv
->name
= pane_string
;
1694 if (keymaps
&& !NILP (prefix
))
1698 wv
->button_type
= BUTTON_TYPE_NONE
;
1703 else if (first_pane
)
1709 i
+= MENU_ITEMS_PANE_LENGTH
;
1713 /* Create a new item within current pane. */
1714 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1716 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1717 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1718 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1719 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1720 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1721 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1722 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1724 #ifndef HAVE_MULTILINGUAL_MENU
1725 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1727 item_name
= ENCODE_SYSTEM (item_name
);
1728 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1730 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1732 descrip
= ENCODE_SYSTEM (descrip
);
1733 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1735 #endif /* not HAVE_MULTILINGUAL_MENU */
1737 wv
= xmalloc_widget_value ();
1741 save_wv
->contents
= wv
;
1742 wv
->name
= (char *) XSTRING (item_name
)->data
;
1743 if (!NILP (descrip
))
1744 wv
->key
= (char *) XSTRING (descrip
)->data
;
1746 /* Use the contents index as call_data, since we are
1747 restricted to 16-bits. */
1748 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1749 wv
->enabled
= !NILP (enable
);
1752 wv
->button_type
= BUTTON_TYPE_NONE
;
1753 else if (EQ (type
, QCtoggle
))
1754 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1755 else if (EQ (type
, QCradio
))
1756 wv
->button_type
= BUTTON_TYPE_RADIO
;
1760 wv
->selected
= !NILP (selected
);
1761 if (!STRINGP (help
))
1768 i
+= MENU_ITEMS_ITEM_LENGTH
;
1772 /* Deal with the title, if it is non-nil. */
1775 widget_value
*wv_title
= xmalloc_widget_value ();
1776 widget_value
*wv_sep
= xmalloc_widget_value ();
1778 /* Maybe replace this separator with a bitmap or owner-draw item
1779 so that it looks better. Having two separators looks odd. */
1780 wv_sep
->name
= "--";
1781 wv_sep
->next
= first_wv
->contents
;
1782 wv_sep
->help
= Qnil
;
1784 #ifndef HAVE_MULTILINGUAL_MENU
1785 if (STRING_MULTIBYTE (title
))
1786 title
= ENCODE_SYSTEM (title
);
1788 wv_title
->name
= (char *) XSTRING (title
)->data
;
1789 wv_title
->enabled
= TRUE
;
1790 wv_title
->title
= TRUE
;
1791 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1792 wv_title
->help
= Qnil
;
1793 wv_title
->next
= wv_sep
;
1794 first_wv
->contents
= wv_title
;
1797 /* Actually create the menu. */
1798 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1799 fill_submenu (menu
, first_wv
->contents
, 0);
1801 /* Adjust coordinates to be root-window-relative. */
1805 #if TARGET_API_MAC_CARBON
1806 SetPort (GetWindowPort (FRAME_MAC_WINDOW (f
)));
1808 SetPort (FRAME_MAC_WINDOW (f
));
1811 LocalToGlobal (&pos
);
1813 /* No selection has been chosen yet. */
1814 menu_item_selection
= 0;
1816 InsertMenu (menu
, -1);
1818 /* Display the menu. */
1819 menu_item_selection
= LoWord (PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0));
1821 DeleteMenu (POPUP_SUBMENU_ID
);
1824 /* Clean up extraneous mouse events which might have been generated
1826 discard_mouse_events ();
1829 /* Free the widget_value objects we used to specify the
1831 free_menubar_widget_value_tree (first_wv
);
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 (menu_item_selection
== 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 #if TARGET_API_MAC_CARBON
1942 SetPort (GetWindowPort (window_ptr
));
1944 SetPort (window_ptr
);
1948 /* Left and right margins in the dialog are 13 pixels each.*/
1950 /* Calculate width of dialog box: 8 pixels on each side of the text
1951 label in each button, 12 pixels between buttons. */
1952 for (i
= 0; i
< nb_buttons
; i
++)
1953 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1955 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1958 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
1960 SizeWindow (window_ptr
, dialog_width
, 78, 0);
1961 ShowWindow (window_ptr
);
1963 #if TARGET_API_MAC_CARBON
1964 SetPort (GetWindowPort (window_ptr
));
1966 SetPort (window_ptr
);
1972 DrawString (prompt
);
1975 for (i
= 0; i
< nb_buttons
; i
++)
1977 int button_width
= StringWidth (button_labels
[i
]) + 16;
1978 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
1979 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
1980 kControlPushButtonProc
, ref_cons
[i
]);
1981 left
+= button_width
+ 12;
1982 if (i
== left_count
- 1)
1989 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
1990 if (event_record
.what
== mouseDown
)
1992 part_code
= FindWindow (event_record
.where
, &window_ptr
);
1993 if (part_code
== inContent
)
1995 mouse
= event_record
.where
;
1996 GlobalToLocal (&mouse
);
1997 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
1998 if (control_part_code
== kControlButtonPart
)
1999 if (TrackControl (ch
, mouse
, NULL
))
2000 i
= GetControlReference (ch
);
2005 DisposeWindow (window_ptr
);
2010 static char * button_names
[] = {
2011 "button1", "button2", "button3", "button4", "button5",
2012 "button6", "button7", "button8", "button9", "button10" };
2015 mac_dialog_show (f
, keymaps
, title
, error
)
2021 int i
, nb_buttons
=0;
2022 char dialog_name
[6];
2023 int menu_item_selection
;
2025 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2027 /* Number of elements seen so far, before boundary. */
2029 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2030 int boundary_seen
= 0;
2034 if (menu_items_n_panes
> 1)
2036 *error
= "Multiple panes in dialog box";
2040 /* Create a tree of widget_value objects
2041 representing the text label and buttons. */
2043 Lisp_Object pane_name
, prefix
;
2045 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2046 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2047 pane_string
= (NILP (pane_name
)
2048 ? "" : (char *) XSTRING (pane_name
)->data
);
2049 prev_wv
= xmalloc_widget_value ();
2050 prev_wv
->value
= pane_string
;
2051 if (keymaps
&& !NILP (prefix
))
2053 prev_wv
->enabled
= 1;
2054 prev_wv
->name
= "message";
2055 prev_wv
->help
= Qnil
;
2058 /* Loop over all panes and items, filling in the tree. */
2059 i
= MENU_ITEMS_PANE_LENGTH
;
2060 while (i
< menu_items_used
)
2063 /* Create a new item within current pane. */
2064 Lisp_Object item_name
, enable
, descrip
, help
;
2066 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2067 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2069 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2070 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2072 if (NILP (item_name
))
2074 free_menubar_widget_value_tree (first_wv
);
2075 *error
= "Submenu in dialog items";
2078 if (EQ (item_name
, Qquote
))
2080 /* This is the boundary between left-side elts
2081 and right-side elts. Stop incrementing right_count. */
2086 if (nb_buttons
>= 9)
2088 free_menubar_widget_value_tree (first_wv
);
2089 *error
= "Too many dialog items";
2093 wv
= xmalloc_widget_value ();
2095 wv
->name
= (char *) button_names
[nb_buttons
];
2096 if (!NILP (descrip
))
2097 wv
->key
= (char *) XSTRING (descrip
)->data
;
2098 wv
->value
= (char *) XSTRING (item_name
)->data
;
2099 wv
->call_data
= (void *) i
;
2100 /* menu item is identified by its index in menu_items table */
2101 wv
->enabled
= !NILP (enable
);
2105 if (! boundary_seen
)
2109 i
+= MENU_ITEMS_ITEM_LENGTH
;
2112 /* If the boundary was not specified,
2113 by default put half on the left and half on the right. */
2114 if (! boundary_seen
)
2115 left_count
= nb_buttons
- nb_buttons
/ 2;
2117 wv
= xmalloc_widget_value ();
2118 wv
->name
= dialog_name
;
2121 /* Dialog boxes use a really stupid name encoding
2122 which specifies how many buttons to use
2123 and how many buttons are on the right.
2124 The Q means something also. */
2125 dialog_name
[0] = 'Q';
2126 dialog_name
[1] = '0' + nb_buttons
;
2127 dialog_name
[2] = 'B';
2128 dialog_name
[3] = 'R';
2129 /* Number of buttons to put on the right. */
2130 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2132 wv
->contents
= first_wv
;
2136 /* Actually create the dialog. */
2138 menu_item_selection
= mac_dialog (first_wv
);
2140 menu_item_selection
= 0;
2143 /* Free the widget_value objects we used to specify the contents. */
2144 free_menubar_widget_value_tree (first_wv
);
2146 /* Find the selected item, and its pane, to return the proper
2148 if (menu_item_selection
!= 0)
2154 while (i
< menu_items_used
)
2158 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2161 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2162 i
+= MENU_ITEMS_PANE_LENGTH
;
2167 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2168 if (menu_item_selection
== i
)
2172 entry
= Fcons (entry
, Qnil
);
2174 entry
= Fcons (prefix
, entry
);
2178 i
+= MENU_ITEMS_ITEM_LENGTH
;
2185 #endif /* HAVE_DIALOGS */
2188 /* Is this item a separator? */
2190 name_is_separator (name
)
2195 /* Check if name string consists of only dashes ('-'). */
2196 while (*name
== '-') name
++;
2197 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2198 or "--deep-shadow". We don't implement them yet, se we just treat
2199 them like normal separators. */
2200 return (*name
== '\0' || start
+ 2 == name
);
2204 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
, int indent
,
2210 if (name_is_separator (wv
->name
))
2211 AppendMenu (menu
, "\p-");
2214 AppendMenu (menu
, "\pX");
2216 #if TARGET_API_MAC_CARBON
2217 pos
= CountMenuItems (menu
);
2219 pos
= CountMItems (menu
);
2222 strcpy (item_name
, "");
2223 for (i
= 0; i
< indent
; i
++)
2224 strcat (item_name
, " ");
2225 strcat (item_name
, wv
->name
);
2226 if (wv
->key
!= NULL
)
2228 strcat (item_name
, " ");
2229 strcat (item_name
, wv
->key
);
2232 SetMenuItemText (menu
, pos
, item_name
);
2234 if (wv
->enabled
&& !force_disable
)
2235 #if TARGET_API_MAC_CARBON
2236 EnableMenuItem (menu
, pos
);
2238 EnableItem (menu
, pos
);
2241 #if TARGET_API_MAC_CARBON
2242 DisableMenuItem (menu
, pos
);
2244 DisableItem (menu
, pos
);
2247 /* Draw radio buttons and tickboxes. */
2249 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2250 wv
->button_type
== BUTTON_TYPE_RADIO
))
2251 SetItemMark (menu
, pos
, checkMark
);
2253 SetItemMark (menu
, pos
, noMark
);
2257 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2259 if (submenu
!= NULL
)
2260 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2263 static int submenu_id
;
2265 /* Construct native Mac OS menubar based on widget_value tree. */
2268 fill_submenu (MenuHandle menu
, widget_value
*wv
, int indent
)
2270 for ( ; wv
!= NULL
; wv
= wv
->next
)
2273 add_menu_item (menu
, wv
, NULL
, indent
, 1);
2275 fill_submenu (menu
, wv
->contents
, indent
+ 1);
2278 add_menu_item (menu
, wv
, NULL
, indent
, 0);
2282 /* Construct native Mac OS menu based on widget_value tree. */
2285 fill_menu (MenuHandle menu
, widget_value
*wv
)
2287 for ( ; wv
!= NULL
; wv
= wv
->next
)
2290 MenuHandle submenu
= NewMenu (submenu_id
, "\pX");
2291 fill_submenu (submenu
, wv
->contents
, 0);
2292 InsertMenu (submenu
, -1);
2293 add_menu_item (menu
, wv
, submenu_id
, 0, 0);
2297 add_menu_item (menu
, wv
, NULL
, 0, 0);
2300 /* Construct native Mac OS menubar based on widget_value tree. */
2303 fill_menubar (widget_value
*wv
)
2307 submenu_id
= MIN_SUBMENU_ID
;
2309 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2314 strcpy (title
, wv
->name
);
2316 menu
= NewMenu (id
, title
);
2319 fill_menu (menu
, wv
->contents
);
2321 InsertMenu (menu
, 0);
2325 #endif /* HAVE_MENUS */
2331 staticpro (&menu_items
);
2334 Qdebug_on_next_call
= intern ("debug-on-next-call");
2335 staticpro (&Qdebug_on_next_call
);
2337 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2338 doc
: /* Frame for which we are updating a menu.
2339 The enable predicate for a menu command should check this variable. */);
2340 Vmenu_updating_frame
= Qnil
;
2342 defsubr (&Sx_popup_menu
);
2344 defsubr (&Sx_popup_dialog
);