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. */
50 #include <Carbon/Carbon.h>
52 #define Z (current_buffer->text->z)
54 #define free unexec_free
56 #define malloc unexec_malloc
58 #define realloc unexec_realloc
60 #define min(a, b) ((a) < (b) ? (a) : (b))
62 #define max(a, b) ((a) > (b) ? (a) : (b))
64 #define init_process emacs_init_process
65 #else /* not MAC_OSX */
68 #include <QuickDraw.h>
69 #include <ToolUtils.h>
74 #if defined (__MRC__) || (__MSL__ >= 0x6000)
75 #include <ControlDefinitions.h>
77 #endif /* not MAC_OSX */
79 /* This may include sys/types.h, and that somehow loses
80 if this is not done before the other system files. */
83 /* Load sys/types.h if not already loaded.
84 In some systems loading it twice is suicidal. */
86 #include <sys/types.h>
89 #include "dispextern.h"
91 #define POPUP_SUBMENU_ID 235
92 #define MIN_POPUP_SUBMENU_ID 512
93 #define MIN_MENU_ID 256
94 #define MIN_SUBMENU_ID 1
96 #define DIALOG_WINDOW_RESOURCE 130
98 #define HAVE_DIALOGS 1
100 #undef HAVE_MULTILINGUAL_MENU
101 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
103 /******************************************************************/
104 /* Definitions copied from lwlib.h */
106 typedef void * XtPointer
;
115 /* This structure is based on the one in ../lwlib/lwlib.h, modified
117 typedef struct _widget_value
121 /* value (meaning depend on widget type) */
123 /* keyboard equivalent. no implications for XtTranslations */
125 /* Help string or nil if none.
126 GC finds this string through the frame's menu_bar_vector
127 or through menu_items. */
129 /* true if enabled */
131 /* true if selected */
133 /* The type of a button. */
134 enum button_type button_type
;
135 /* true if menu title */
138 /* true if was edited (maintained by get_value) */
140 /* true if has changed (maintained by lw library) */
142 /* true if this widget itself has changed,
143 but not counting the other widgets found in the `next' field. */
144 change_type this_one_change
;
146 /* Contents of the sub-widgets, also selected slot for checkbox */
147 struct _widget_value
* contents
;
148 /* data passed to callback */
150 /* next one in the list */
151 struct _widget_value
* next
;
153 /* slot for the toolkit dependent part. Always initialize to NULL. */
155 /* tell us if we should free the toolkit data slot when freeing the
156 widget_value itself. */
157 Boolean free_toolkit_data
;
159 /* we resource the widget_value structures; this points to the next
160 one on the free list if this one has been deallocated.
162 struct _widget_value
*free_list
;
166 /* Assumed by other routines to zero area returned. */
167 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
168 0, (sizeof (widget_value)))
169 #define free_widget_value(wv) xfree (wv)
171 /******************************************************************/
178 Lisp_Object Vmenu_updating_frame
;
180 Lisp_Object Qdebug_on_next_call
;
182 extern Lisp_Object Qmenu_bar
;
184 extern Lisp_Object QCtoggle
, QCradio
;
186 extern Lisp_Object Voverriding_local_map
;
187 extern Lisp_Object Voverriding_local_map_menu_flag
;
189 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
191 extern Lisp_Object Qmenu_bar_update_hook
;
193 void set_frame_menubar ();
195 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
196 Lisp_Object
, Lisp_Object
, Lisp_Object
,
197 Lisp_Object
, Lisp_Object
));
199 static Lisp_Object
mac_dialog_show ();
201 static Lisp_Object
mac_menu_show ();
203 static void keymap_panes ();
204 static void single_keymap_panes ();
205 static void single_menu_item ();
206 static void list_of_panes ();
207 static void list_of_items ();
209 static void fill_submenu (MenuHandle
, widget_value
*);
210 static void fill_menubar (widget_value
*);
213 /* This holds a Lisp vector that holds the results of decoding
214 the keymaps or alist-of-alists that specify a menu.
216 It describes the panes and items within the panes.
218 Each pane is described by 3 elements in the vector:
219 t, the pane name, the pane's prefix key.
220 Then follow the pane's items, with 5 elements per item:
221 the item string, the enable flag, the item's value,
222 the definition, and the equivalent keyboard key's description string.
224 In some cases, multiple levels of menus may be described.
225 A single vector slot containing nil indicates the start of a submenu.
226 A single vector slot containing lambda indicates the end of a submenu.
227 The submenu follows a menu item which is the way to reach the submenu.
229 A single vector slot containing quote indicates that the
230 following items should appear on the right of a dialog box.
232 Using a Lisp vector to hold this information while we decode it
233 takes care of protecting all the data from GC. */
235 #define MENU_ITEMS_PANE_NAME 1
236 #define MENU_ITEMS_PANE_PREFIX 2
237 #define MENU_ITEMS_PANE_LENGTH 3
241 MENU_ITEMS_ITEM_NAME
= 0,
242 MENU_ITEMS_ITEM_ENABLE
,
243 MENU_ITEMS_ITEM_VALUE
,
244 MENU_ITEMS_ITEM_EQUIV_KEY
,
245 MENU_ITEMS_ITEM_DEFINITION
,
246 MENU_ITEMS_ITEM_TYPE
,
247 MENU_ITEMS_ITEM_SELECTED
,
248 MENU_ITEMS_ITEM_HELP
,
249 MENU_ITEMS_ITEM_LENGTH
252 static Lisp_Object menu_items
;
254 /* Number of slots currently allocated in menu_items. */
255 static int menu_items_allocated
;
257 /* This is the index in menu_items of the first empty slot. */
258 static int menu_items_used
;
260 /* The number of panes currently recorded in menu_items,
261 excluding those within submenus. */
262 static int menu_items_n_panes
;
264 /* Current depth within submenus. */
265 static int menu_items_submenu_depth
;
267 /* Flag which when set indicates a dialog or menu has been posted by
268 Xt on behalf of one of the widget sets. */
269 static int popup_activated_flag
;
271 /* Index of the next submenu */
272 static int submenu_id
;
274 static int next_menubar_widget_id
;
276 /* This is set nonzero after the user activates the menu bar, and set
277 to zero again after the menu bars are redisplayed by prepare_menu_bar.
278 While it is nonzero, all calls to set_frame_menubar go deep.
280 I don't understand why this is needed, but it does seem to be
281 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
283 int pending_menu_activation
;
285 /* Initialize the menu_items structure if we haven't already done so.
286 Also mark it as currently empty. */
291 if (NILP (menu_items
))
293 menu_items_allocated
= 60;
294 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
298 menu_items_n_panes
= 0;
299 menu_items_submenu_depth
= 0;
302 /* Call at the end of generating the data in menu_items.
303 This fills in the number of items in the last pane. */
310 /* Call when finished using the data for the current menu
314 discard_menu_items ()
316 /* Free the structure if it is especially large.
317 Otherwise, hold on to it, to save time. */
318 if (menu_items_allocated
> 200)
321 menu_items_allocated
= 0;
325 /* Make the menu_items vector twice as large. */
331 int old_size
= menu_items_allocated
;
334 menu_items_allocated
*= 2;
335 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
336 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
337 old_size
* sizeof (Lisp_Object
));
340 /* Begin a submenu. */
343 push_submenu_start ()
345 if (menu_items_used
+ 1 > menu_items_allocated
)
348 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
349 menu_items_submenu_depth
++;
357 if (menu_items_used
+ 1 > menu_items_allocated
)
360 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
361 menu_items_submenu_depth
--;
364 /* Indicate boundary between left and right. */
367 push_left_right_boundary ()
369 if (menu_items_used
+ 1 > menu_items_allocated
)
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
375 /* Start a new menu pane in menu_items.
376 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
379 push_menu_pane (name
, prefix_vec
)
380 Lisp_Object name
, prefix_vec
;
382 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
385 if (menu_items_submenu_depth
== 0)
386 menu_items_n_panes
++;
387 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
388 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
389 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
392 /* Push one menu item into the current pane. NAME is the string to
393 display. ENABLE if non-nil means this item can be selected. KEY
394 is the key generated by choosing this item, or nil if this item
395 doesn't really have a definition. DEF is the definition of this
396 item. EQUIV is the textual description of the keyboard equivalent
397 for this item (or nil if none). TYPE is the type of this menu
398 item, one of nil, `toggle' or `radio'. */
401 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
402 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
404 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
407 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
408 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
409 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
410 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
411 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
412 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
413 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
414 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
417 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
418 and generate menu panes for them in menu_items.
419 If NOTREAL is nonzero,
420 don't bother really computing whether an item is enabled. */
423 keymap_panes (keymaps
, nmaps
, notreal
)
424 Lisp_Object
*keymaps
;
432 /* Loop over the given keymaps, making a pane for each map.
433 But don't make a pane that is empty--ignore that map instead.
434 P is the number of panes we have made so far. */
435 for (mapno
= 0; mapno
< nmaps
; mapno
++)
436 single_keymap_panes (keymaps
[mapno
],
437 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
439 finish_menu_items ();
442 /* This is a recursive subroutine of keymap_panes.
443 It handles one keymap, KEYMAP.
444 The other arguments are passed along
445 or point to local variables of the previous function.
446 If NOTREAL is nonzero, only check for equivalent key bindings, don't
447 evaluate expressions in menu items and don't make any menu.
449 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
452 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
454 Lisp_Object pane_name
;
459 Lisp_Object pending_maps
= Qnil
;
460 Lisp_Object tail
, item
;
461 struct gcpro gcpro1
, gcpro2
;
466 push_menu_pane (pane_name
, prefix
);
468 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
470 GCPRO2 (keymap
, pending_maps
);
471 /* Look at each key binding, and if it is a menu item add it
475 single_menu_item (XCAR (item
), XCDR (item
),
476 &pending_maps
, notreal
, maxdepth
);
477 else if (VECTORP (item
))
479 /* Loop over the char values represented in the vector. */
480 int len
= XVECTOR (item
)->size
;
482 for (c
= 0; c
< len
; c
++)
484 Lisp_Object character
;
485 XSETFASTINT (character
, c
);
486 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
487 &pending_maps
, notreal
, maxdepth
);
493 /* Process now any submenus which want to be panes at this level. */
494 while (!NILP (pending_maps
))
496 Lisp_Object elt
, eltcdr
, string
;
497 elt
= Fcar (pending_maps
);
499 string
= XCAR (eltcdr
);
500 /* We no longer discard the @ from the beginning of the string here.
501 Instead, we do this in mac_menu_show. */
502 single_keymap_panes (Fcar (elt
), string
,
503 XCDR (eltcdr
), notreal
, maxdepth
- 1);
504 pending_maps
= Fcdr (pending_maps
);
508 /* This is a subroutine of single_keymap_panes that handles one
510 KEY is a key in a keymap and ITEM is its binding.
511 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
513 If NOTREAL is nonzero, only check for equivalent key bindings, don't
514 evaluate expressions in menu items and don't make any menu.
515 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
518 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
519 Lisp_Object key
, item
;
520 Lisp_Object
*pending_maps_ptr
;
521 int maxdepth
, notreal
;
523 Lisp_Object map
, item_string
, enabled
;
524 struct gcpro gcpro1
, gcpro2
;
527 /* Parse the menu item and leave the result in item_properties. */
529 res
= parse_menu_item (item
, notreal
, 0);
532 return; /* Not a menu item. */
534 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
538 /* We don't want to make a menu, just traverse the keymaps to
539 precompute equivalent key bindings. */
541 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
545 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
546 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
548 if (!NILP (map
) && SREF (item_string
, 0) == '@')
551 /* An enabled separate pane. Remember this to handle it later. */
552 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
557 push_menu_item (item_string
, enabled
, key
,
558 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
559 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
560 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
561 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
562 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
564 /* Display a submenu using the toolkit. */
565 if (! (NILP (map
) || NILP (enabled
)))
567 push_submenu_start ();
568 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
573 /* Push all the panes and items of a menu described by the
574 alist-of-alists MENU.
575 This handles old-fashioned calls to x-popup-menu. */
585 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
587 Lisp_Object elt
, pane_name
, pane_data
;
589 pane_name
= Fcar (elt
);
590 CHECK_STRING (pane_name
);
591 push_menu_pane (pane_name
, Qnil
);
592 pane_data
= Fcdr (elt
);
593 CHECK_CONS (pane_data
);
594 list_of_items (pane_data
);
597 finish_menu_items ();
600 /* Push the items in a single pane defined by the alist PANE. */
606 Lisp_Object tail
, item
, item1
;
608 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
612 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
613 else if (NILP (item
))
614 push_left_right_boundary ();
619 CHECK_STRING (item1
);
620 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
625 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
626 doc
: /* Pop up a deck-of-cards menu and return user's selection.
627 POSITION is a position specification. This is either a mouse button
628 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
629 are positions in pixels from the top left corner of WINDOW's frame
630 \(WINDOW may be a frame object instead of a window). This controls the
631 position of the center of the first line in the first pane of the
632 menu, not the top left of the menu as a whole. If POSITION is t, it
633 means to use the current mouse position.
635 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
636 The menu items come from key bindings that have a menu string as well as
637 a definition; actually, the \"definition\" in such a key binding looks like
638 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
639 the keymap as a top-level element.
641 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
642 Otherwise, REAL-DEFINITION should be a valid key binding definition.
644 You can also use a list of keymaps as MENU. Then each keymap makes a
645 separate pane. When MENU is a keymap or a list of keymaps, the return
646 value is a list of events.
648 Alternatively, you can specify a menu of multiple panes with a list of
649 the form (TITLE PANE1 PANE2...), where each pane is a list of
650 form (TITLE ITEM1 ITEM2...).
651 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
652 appear as an item--that makes a nonselectable line in the menu.
653 With this form of menu, the return value is VALUE from the chosen item.
655 If POSITION is nil, don't display the menu at all, just precalculate the
656 cached information about equivalent key sequences. */)
658 Lisp_Object position
, menu
;
660 Lisp_Object keymap
, tem
;
661 int xpos
= 0, ypos
= 0;
664 Lisp_Object selection
;
666 Lisp_Object x
, y
, window
;
672 if (! NILP (position
))
676 /* Decode the first argument: find the window and the coordinates. */
677 if (EQ (position
, Qt
)
678 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
679 || EQ (XCAR (position
), Qtool_bar
))))
681 /* Use the mouse's current position. */
682 FRAME_PTR new_f
= SELECTED_FRAME ();
683 Lisp_Object bar_window
;
684 enum scroll_bar_part part
;
687 if (mouse_position_hook
)
688 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
689 &part
, &x
, &y
, &time
);
691 XSETFRAME (window
, new_f
);
694 window
= selected_window
;
701 tem
= Fcar (position
);
704 window
= Fcar (Fcdr (position
));
706 y
= Fcar (Fcdr (tem
));
711 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
712 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
713 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
722 /* Decode where to put the menu. */
730 else if (WINDOWP (window
))
732 CHECK_LIVE_WINDOW (window
);
733 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
735 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
736 * XFASTINT (XWINDOW (window
)->left
));
737 ypos
= (FRAME_LINE_HEIGHT (f
)
738 * XFASTINT (XWINDOW (window
)->top
));
741 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
742 but I don't want to make one now. */
743 CHECK_WINDOW (window
);
748 XSETFRAME (Vmenu_updating_frame
, f
);
750 Vmenu_updating_frame
= Qnil
;
751 #endif /* HAVE_MENUS */
756 /* Decode the menu items from what was specified. */
758 keymap
= get_keymap (menu
, 0, 0);
761 /* We were given a keymap. Extract menu info from the keymap. */
764 /* Extract the detailed info to make one pane. */
765 keymap_panes (&menu
, 1, NILP (position
));
767 /* Search for a string appearing directly as an element of the keymap.
768 That string is the title of the menu. */
769 prompt
= Fkeymap_prompt (keymap
);
770 if (NILP (title
) && !NILP (prompt
))
773 /* Make that be the pane title of the first pane. */
774 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
775 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
779 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
781 /* We were given a list of keymaps. */
782 int nmaps
= XFASTINT (Flength (menu
));
784 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
789 /* The first keymap that has a prompt string
790 supplies the menu title. */
791 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
795 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
797 prompt
= Fkeymap_prompt (keymap
);
798 if (NILP (title
) && !NILP (prompt
))
802 /* Extract the detailed info to make one pane. */
803 keymap_panes (maps
, nmaps
, NILP (position
));
805 /* Make the title be the pane title of the first pane. */
806 if (!NILP (title
) && menu_items_n_panes
>= 0)
807 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
813 /* We were given an old-fashioned menu. */
815 CHECK_STRING (title
);
817 list_of_panes (Fcdr (menu
));
824 discard_menu_items ();
830 /* Display them in a menu. */
833 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
834 keymaps
, title
, &error_name
);
837 discard_menu_items ();
840 #endif /* HAVE_MENUS */
842 if (error_name
) error (error_name
);
848 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
849 doc
: /* Pop up a dialog box and return user's selection.
850 POSITION specifies which frame to use.
851 This is normally a mouse button event or a window or frame.
852 If POSITION is t, it means to use the frame the mouse is on.
853 The dialog box appears in the middle of the specified frame.
855 CONTENTS specifies the alternatives to display in the dialog box.
856 It is a list of the form (TITLE ITEM1 ITEM2...).
857 Each ITEM is a cons cell (STRING . VALUE).
858 The return value is VALUE from the chosen item.
860 An ITEM may also be just a string--that makes a nonselectable item.
861 An ITEM may also be nil--that means to put all preceding items
862 on the left of the dialog box and all following items on the right.
863 \(By default, approximately half appear on each side.) */)
865 Lisp_Object position
, contents
;
872 /* Decode the first argument: find the window or frame to use. */
873 if (EQ (position
, Qt
)
874 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
875 || EQ (XCAR (position
), Qtool_bar
))))
877 #if 0 /* Using the frame the mouse is on may not be right. */
878 /* Use the mouse's current position. */
879 FRAME_PTR new_f
= SELECTED_FRAME ();
880 Lisp_Object bar_window
;
881 enum scroll_bar_part part
;
885 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
888 XSETFRAME (window
, new_f
);
890 window
= selected_window
;
892 window
= selected_window
;
894 else if (CONSP (position
))
897 tem
= Fcar (position
);
899 window
= Fcar (Fcdr (position
));
902 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
903 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
906 else if (WINDOWP (position
) || FRAMEP (position
))
911 /* Decode where to put the menu. */
915 else if (WINDOWP (window
))
917 CHECK_LIVE_WINDOW (window
);
918 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
921 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
922 but I don't want to make one now. */
923 CHECK_WINDOW (window
);
926 /* Display a menu with these alternatives
927 in the middle of frame F. */
929 Lisp_Object x
, y
, frame
, newpos
;
930 XSETFRAME (frame
, f
);
931 XSETINT (x
, x_pixel_width (f
) / 2);
932 XSETINT (y
, x_pixel_height (f
) / 2);
933 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
935 return Fx_popup_menu (newpos
,
936 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
938 #else /* HAVE_DIALOGS */
942 Lisp_Object selection
;
944 /* Decode the dialog items from what was specified. */
945 title
= Fcar (contents
);
946 CHECK_STRING (title
);
948 list_of_panes (Fcons (contents
, Qnil
));
950 /* Display them in a dialog box. */
952 selection
= mac_dialog_show (f
, 0, title
, &error_name
);
955 discard_menu_items ();
957 if (error_name
) error (error_name
);
960 #endif /* HAVE_DIALOGS */
963 /* Activate the menu bar of frame F.
964 This is called from keyboard.c when it gets the
965 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
967 To activate the menu bar, we signal to the input thread that it can
968 return from the WM_INITMENU message, allowing the normal Windows
969 processing of the menus.
971 But first we recompute the menu bar contents (the whole tree).
973 This way we can safely execute Lisp code. */
976 x_activate_menubar (f
)
980 extern Point saved_menu_event_location
;
982 set_frame_menubar (f
, 0, 1);
985 menu_choice
= MenuSelect (saved_menu_event_location
);
986 do_menu_choice (menu_choice
);
991 /* This callback is called from the menu bar pulldown menu
992 when the user makes a selection.
993 Figure out what the user chose
994 and put the appropriate events into the keyboard buffer. */
997 menubar_selection_callback (FRAME_PTR f
, int client_data
)
999 Lisp_Object prefix
, entry
;
1001 Lisp_Object
*subprefix_stack
;
1002 int submenu_depth
= 0;
1008 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1009 vector
= f
->menu_bar_vector
;
1012 while (i
< f
->menu_bar_items_used
)
1014 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1016 subprefix_stack
[submenu_depth
++] = prefix
;
1020 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1022 prefix
= subprefix_stack
[--submenu_depth
];
1025 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1027 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1028 i
+= MENU_ITEMS_PANE_LENGTH
;
1032 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1033 /* The EMACS_INT cast avoids a warning. There's no problem
1034 as long as pointers have enough bits to hold small integers. */
1035 if ((int) (EMACS_INT
) client_data
== i
)
1038 struct input_event buf
;
1041 XSETFRAME (frame
, f
);
1042 buf
.kind
= MENU_BAR_EVENT
;
1043 buf
.frame_or_window
= frame
;
1045 kbd_buffer_store_event (&buf
);
1047 for (j
= 0; j
< submenu_depth
; j
++)
1048 if (!NILP (subprefix_stack
[j
]))
1050 buf
.kind
= MENU_BAR_EVENT
;
1051 buf
.frame_or_window
= frame
;
1052 buf
.arg
= subprefix_stack
[j
];
1053 kbd_buffer_store_event (&buf
);
1058 buf
.kind
= MENU_BAR_EVENT
;
1059 buf
.frame_or_window
= frame
;
1061 kbd_buffer_store_event (&buf
);
1064 buf
.kind
= MENU_BAR_EVENT
;
1065 buf
.frame_or_window
= frame
;
1067 kbd_buffer_store_event (&buf
);
1069 f
->output_data
.mac
->menu_command_in_progress
= 0;
1070 f
->output_data
.mac
->menubar_active
= 0;
1073 i
+= MENU_ITEMS_ITEM_LENGTH
;
1076 f
->output_data
.mac
->menu_command_in_progress
= 0;
1077 f
->output_data
.mac
->menubar_active
= 0;
1080 /* Allocate a widget_value, blocking input. */
1083 xmalloc_widget_value ()
1085 widget_value
*value
;
1088 value
= malloc_widget_value ();
1094 /* This recursively calls free_widget_value on the tree of widgets.
1095 It must free all data that was malloc'ed for these widget_values.
1096 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1097 must be left alone. */
1100 free_menubar_widget_value_tree (wv
)
1105 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1107 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1109 free_menubar_widget_value_tree (wv
->contents
);
1110 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1114 free_menubar_widget_value_tree (wv
->next
);
1115 wv
->next
= (widget_value
*) 0xDEADBEEF;
1118 free_widget_value (wv
);
1122 /* Return a tree of widget_value structures for a menu bar item
1123 whose event type is ITEM_KEY (with string ITEM_NAME)
1124 and whose contents come from the list of keymaps MAPS. */
1126 static widget_value
*
1127 single_submenu (item_key
, item_name
, maps
)
1128 Lisp_Object item_key
, item_name
, maps
;
1130 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1132 int submenu_depth
= 0;
1135 Lisp_Object
*mapvec
;
1136 widget_value
**submenu_stack
;
1137 int previous_items
= menu_items_used
;
1138 int top_level_items
= 0;
1140 length
= Flength (maps
);
1141 len
= XINT (length
);
1143 /* Convert the list MAPS into a vector MAPVEC. */
1144 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1145 for (i
= 0; i
< len
; i
++)
1147 mapvec
[i
] = Fcar (maps
);
1151 menu_items_n_panes
= 0;
1153 /* Loop over the given keymaps, making a pane for each map.
1154 But don't make a pane that is empty--ignore that map instead. */
1155 for (i
= 0; i
< len
; i
++)
1157 if (SYMBOLP (mapvec
[i
])
1158 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1160 /* Here we have a command at top level in the menu bar
1161 as opposed to a submenu. */
1162 top_level_items
= 1;
1163 push_menu_pane (Qnil
, Qnil
);
1164 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1165 Qnil
, Qnil
, Qnil
, Qnil
);
1168 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1171 /* Create a tree of widget_value objects
1172 representing the panes and their items. */
1175 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1176 wv
= xmalloc_widget_value ();
1180 wv
->button_type
= BUTTON_TYPE_NONE
;
1186 /* Loop over all panes and items made during this call
1187 and construct a tree of widget_value objects.
1188 Ignore the panes and items made by previous calls to
1189 single_submenu, even though those are also in menu_items. */
1191 while (i
< menu_items_used
)
1193 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1195 submenu_stack
[submenu_depth
++] = save_wv
;
1200 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1203 save_wv
= submenu_stack
[--submenu_depth
];
1206 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1207 && submenu_depth
!= 0)
1208 i
+= MENU_ITEMS_PANE_LENGTH
;
1209 /* Ignore a nil in the item list.
1210 It's meaningful only for dialog boxes. */
1211 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1213 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1215 /* Create a new pane. */
1216 Lisp_Object pane_name
, prefix
;
1219 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1220 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1222 #ifndef HAVE_MULTILINGUAL_MENU
1223 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1225 pane_name
= ENCODE_SYSTEM (pane_name
);
1226 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1229 pane_string
= (NILP (pane_name
)
1230 ? "" : (char *) SDATA (pane_name
));
1231 /* If there is just one top-level pane, put all its items directly
1232 under the top-level menu. */
1233 if (menu_items_n_panes
== 1)
1236 /* If the pane has a meaningful name,
1237 make the pane a top-level menu item
1238 with its items as a submenu beneath it. */
1239 if (strcmp (pane_string
, ""))
1241 wv
= xmalloc_widget_value ();
1245 first_wv
->contents
= wv
;
1246 wv
->name
= pane_string
;
1247 /* Ignore the @ that means "separate pane".
1248 This is a kludge, but this isn't worth more time. */
1249 if (!NILP (prefix
) && wv
->name
[0] == '@')
1253 wv
->button_type
= BUTTON_TYPE_NONE
;
1258 i
+= MENU_ITEMS_PANE_LENGTH
;
1262 /* Create a new item within current pane. */
1263 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1266 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1267 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1268 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1269 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1270 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1271 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1272 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1274 #ifndef HAVE_MULTILINGUAL_MENU
1275 if (STRING_MULTIBYTE (item_name
))
1277 item_name
= ENCODE_SYSTEM (item_name
);
1278 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1281 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1283 descrip
= ENCODE_SYSTEM (descrip
);
1284 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1286 #endif /* not HAVE_MULTILINGUAL_MENU */
1288 wv
= xmalloc_widget_value ();
1292 save_wv
->contents
= wv
;
1294 wv
->name
= (char *) SDATA (item_name
);
1295 if (!NILP (descrip
))
1296 wv
->key
= (char *) SDATA (descrip
);
1298 /* The EMACS_INT cast avoids a warning. There's no problem
1299 as long as pointers have enough bits to hold small integers. */
1300 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1301 wv
->enabled
= !NILP (enable
);
1304 wv
->button_type
= BUTTON_TYPE_NONE
;
1305 else if (EQ (type
, QCradio
))
1306 wv
->button_type
= BUTTON_TYPE_RADIO
;
1307 else if (EQ (type
, QCtoggle
))
1308 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1312 wv
->selected
= !NILP (selected
);
1313 if (!STRINGP (help
))
1320 i
+= MENU_ITEMS_ITEM_LENGTH
;
1324 /* If we have just one "menu item"
1325 that was originally a button, return it by itself. */
1326 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1328 wv
= first_wv
->contents
;
1329 free_widget_value (first_wv
);
1336 /* Set the contents of the menubar widgets of frame F.
1337 The argument FIRST_TIME is currently ignored;
1338 it is set the first time this is called, from initialize_frame_menubar. */
1341 set_frame_menubar (f
, first_time
, deep_p
)
1346 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1348 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1351 /* We must not change the menubar when actually in use. */
1352 if (f
->output_data
.mac
->menubar_active
)
1355 XSETFRAME (Vmenu_updating_frame
, f
);
1357 if (! menubar_widget
)
1359 else if (pending_menu_activation
&& !deep_p
)
1362 wv
= xmalloc_widget_value ();
1363 wv
->name
= "menubar";
1366 wv
->button_type
= BUTTON_TYPE_NONE
;
1372 /* Make a widget-value tree representing the entire menu trees. */
1374 struct buffer
*prev
= current_buffer
;
1376 int specpdl_count
= SPECPDL_INDEX ();
1377 int previous_menu_items_used
= f
->menu_bar_items_used
;
1378 Lisp_Object
*previous_items
1379 = (Lisp_Object
*) alloca (previous_menu_items_used
1380 * sizeof (Lisp_Object
));
1382 /* If we are making a new widget, its contents are empty,
1383 do always reinitialize them. */
1384 if (! menubar_widget
)
1385 previous_menu_items_used
= 0;
1387 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1388 specbind (Qinhibit_quit
, Qt
);
1389 /* Don't let the debugger step into this code
1390 because it is not reentrant. */
1391 specbind (Qdebug_on_next_call
, Qnil
);
1393 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1394 if (NILP (Voverriding_local_map_menu_flag
))
1396 specbind (Qoverriding_terminal_local_map
, Qnil
);
1397 specbind (Qoverriding_local_map
, Qnil
);
1400 set_buffer_internal_1 (XBUFFER (buffer
));
1402 /* Run the Lucid hook. */
1403 safe_run_hooks (Qactivate_menubar_hook
);
1404 /* If it has changed current-menubar from previous value,
1405 really recompute the menubar from the value. */
1406 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1407 call0 (Qrecompute_lucid_menubar
);
1408 safe_run_hooks (Qmenu_bar_update_hook
);
1409 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1411 items
= FRAME_MENU_BAR_ITEMS (f
);
1413 inhibit_garbage_collection ();
1415 /* Save the frame's previous menu bar contents data. */
1416 if (previous_menu_items_used
)
1417 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1418 previous_menu_items_used
* sizeof (Lisp_Object
));
1420 /* Fill in the current menu bar contents. */
1421 menu_items
= f
->menu_bar_vector
;
1422 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1424 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1426 Lisp_Object key
, string
, maps
;
1428 key
= XVECTOR (items
)->contents
[i
];
1429 string
= XVECTOR (items
)->contents
[i
+ 1];
1430 maps
= XVECTOR (items
)->contents
[i
+ 2];
1434 wv
= single_submenu (key
, string
, maps
);
1438 first_wv
->contents
= wv
;
1439 /* Don't set wv->name here; GC during the loop might relocate it. */
1441 wv
->button_type
= BUTTON_TYPE_NONE
;
1445 finish_menu_items ();
1447 set_buffer_internal_1 (prev
);
1448 unbind_to (specpdl_count
, Qnil
);
1450 /* If there has been no change in the Lisp-level contents
1451 of the menu bar, skip redisplaying it. Just exit. */
1453 for (i
= 0; i
< previous_menu_items_used
; i
++)
1454 if (menu_items_used
== i
1455 || (!Fequal (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1457 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1459 free_menubar_widget_value_tree (first_wv
);
1465 /* Now GC cannot happen during the lifetime of the widget_value,
1466 so it's safe to store data from a Lisp_String, as long as
1467 local copies are made when the actual menu is created.
1468 Windows takes care of this for normal string items, but
1469 not for owner-drawn items or additional item-info. */
1470 wv
= first_wv
->contents
;
1471 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1474 string
= XVECTOR (items
)->contents
[i
+ 1];
1477 wv
->name
= (char *) SDATA (string
);
1481 f
->menu_bar_vector
= menu_items
;
1482 f
->menu_bar_items_used
= menu_items_used
;
1487 /* Make a widget-value tree containing
1488 just the top level menu bar strings. */
1490 items
= FRAME_MENU_BAR_ITEMS (f
);
1491 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1495 string
= XVECTOR (items
)->contents
[i
+ 1];
1499 wv
= xmalloc_widget_value ();
1500 wv
->name
= (char *) SDATA (string
);
1503 wv
->button_type
= BUTTON_TYPE_NONE
;
1505 /* This prevents lwlib from assuming this
1506 menu item is really supposed to be empty. */
1507 /* The EMACS_INT cast avoids a warning.
1508 This value just has to be different from small integers. */
1509 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1514 first_wv
->contents
= wv
;
1518 /* Forget what we thought we knew about what is in the
1519 detailed contents of the menu bar menus.
1520 Changing the top level always destroys the contents. */
1521 f
->menu_bar_items_used
= 0;
1524 /* Create or update the menu bar widget. */
1528 /* Non-null value to indicate menubar has already been "created". */
1529 f
->output_data
.mac
->menubar_widget
= 1;
1532 int i
= MIN_MENU_ID
;
1533 MenuHandle menu
= GetMenuHandle (i
);
1534 while (menu
!= NULL
)
1538 menu
= GetMenuHandle (++i
);
1542 menu
= GetMenuHandle (i
);
1543 while (menu
!= NULL
)
1547 menu
= GetMenuHandle (++i
);
1551 fill_menubar (first_wv
->contents
);
1555 free_menubar_widget_value_tree (first_wv
);
1560 /* Called from Fx_create_frame to create the initial menubar of a frame
1561 before it is mapped, so that the window is mapped with the menubar already
1562 there instead of us tacking it on later and thrashing the window after it
1566 initialize_frame_menubar (f
)
1569 /* This function is called before the first chance to redisplay
1570 the frame. It has to be, so the frame will have the right size. */
1571 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1572 set_frame_menubar (f
, 1, 1);
1575 /* Get rid of the menu bar of frame F, and free its storage.
1576 This is used when deleting a frame, and when turning off the menu bar. */
1579 free_frame_menubar (f
)
1582 f
->output_data
.mac
->menubar_widget
= NULL
;
1586 /* mac_menu_show actually displays a menu using the panes and items in
1587 menu_items and returns the value selected from it; we assume input
1588 is blocked by the caller. */
1590 /* F is the frame the menu is for.
1591 X and Y are the frame-relative specified position,
1592 relative to the inside upper left corner of the frame F.
1593 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1594 KEYMAPS is 1 if this menu was specified with keymaps;
1595 in that case, we return a list containing the chosen item's value
1596 and perhaps also the pane's prefix.
1597 TITLE is the specified menu title.
1598 ERROR is a place to store an error message string in case of failure.
1599 (We return nil on failure, but the value doesn't actually matter.) */
1602 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1613 int menu_item_choice
;
1614 int menu_item_selection
;
1617 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1618 widget_value
**submenu_stack
1619 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1620 Lisp_Object
*subprefix_stack
1621 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1622 int submenu_depth
= 0;
1627 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1629 *error
= "Empty menu";
1633 /* Create a tree of widget_value objects
1634 representing the panes and their items. */
1635 wv
= xmalloc_widget_value ();
1639 wv
->button_type
= BUTTON_TYPE_NONE
;
1644 /* Loop over all panes and items, filling in the tree. */
1646 while (i
< menu_items_used
)
1648 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1650 submenu_stack
[submenu_depth
++] = save_wv
;
1656 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1659 save_wv
= submenu_stack
[--submenu_depth
];
1663 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1664 && submenu_depth
!= 0)
1665 i
+= MENU_ITEMS_PANE_LENGTH
;
1666 /* Ignore a nil in the item list.
1667 It's meaningful only for dialog boxes. */
1668 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1670 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1672 /* Create a new pane. */
1673 Lisp_Object pane_name
, prefix
;
1675 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1676 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1677 #ifndef HAVE_MULTILINGUAL_MENU
1678 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1680 pane_name
= ENCODE_SYSTEM (pane_name
);
1681 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1684 pane_string
= (NILP (pane_name
)
1685 ? "" : (char *) SDATA (pane_name
));
1686 /* If there is just one top-level pane, put all its items directly
1687 under the top-level menu. */
1688 if (menu_items_n_panes
== 1)
1691 /* If the pane has a meaningful name,
1692 make the pane a top-level menu item
1693 with its items as a submenu beneath it. */
1694 if (!keymaps
&& strcmp (pane_string
, ""))
1696 wv
= xmalloc_widget_value ();
1700 first_wv
->contents
= wv
;
1701 wv
->name
= pane_string
;
1702 if (keymaps
&& !NILP (prefix
))
1706 wv
->button_type
= BUTTON_TYPE_NONE
;
1711 else if (first_pane
)
1717 i
+= MENU_ITEMS_PANE_LENGTH
;
1721 /* Create a new item within current pane. */
1722 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1724 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1725 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1726 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1727 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1728 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1729 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1730 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1732 #ifndef HAVE_MULTILINGUAL_MENU
1733 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1735 item_name
= ENCODE_SYSTEM (item_name
);
1736 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1738 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1740 descrip
= ENCODE_SYSTEM (descrip
);
1741 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1743 #endif /* not HAVE_MULTILINGUAL_MENU */
1745 wv
= xmalloc_widget_value ();
1749 save_wv
->contents
= wv
;
1750 wv
->name
= (char *) SDATA (item_name
);
1751 if (!NILP (descrip
))
1752 wv
->key
= (char *) SDATA (descrip
);
1754 /* Use the contents index as call_data, since we are
1755 restricted to 16-bits. */
1756 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1757 wv
->enabled
= !NILP (enable
);
1760 wv
->button_type
= BUTTON_TYPE_NONE
;
1761 else if (EQ (type
, QCtoggle
))
1762 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1763 else if (EQ (type
, QCradio
))
1764 wv
->button_type
= BUTTON_TYPE_RADIO
;
1768 wv
->selected
= !NILP (selected
);
1769 if (!STRINGP (help
))
1776 i
+= MENU_ITEMS_ITEM_LENGTH
;
1780 /* Deal with the title, if it is non-nil. */
1783 widget_value
*wv_title
= xmalloc_widget_value ();
1784 widget_value
*wv_sep
= xmalloc_widget_value ();
1786 /* Maybe replace this separator with a bitmap or owner-draw item
1787 so that it looks better. Having two separators looks odd. */
1788 wv_sep
->name
= "--";
1789 wv_sep
->next
= first_wv
->contents
;
1790 wv_sep
->help
= Qnil
;
1792 #ifndef HAVE_MULTILINGUAL_MENU
1793 if (STRING_MULTIBYTE (title
))
1794 title
= ENCODE_SYSTEM (title
);
1796 wv_title
->name
= (char *) SDATA (title
);
1797 wv_title
->enabled
= TRUE
;
1798 wv_title
->title
= TRUE
;
1799 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1800 wv_title
->help
= Qnil
;
1801 wv_title
->next
= wv_sep
;
1802 first_wv
->contents
= wv_title
;
1805 /* Actually create the menu. */
1806 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1807 submenu_id
= MIN_POPUP_SUBMENU_ID
;
1808 fill_submenu (menu
, first_wv
->contents
);
1810 /* Adjust coordinates to be root-window-relative. */
1814 #if TARGET_API_MAC_CARBON
1815 SetPort (GetWindowPort (FRAME_MAC_WINDOW (f
)));
1817 SetPort (FRAME_MAC_WINDOW (f
));
1820 LocalToGlobal (&pos
);
1822 /* No selection has been chosen yet. */
1823 menu_item_choice
= 0;
1824 menu_item_selection
= 0;
1826 InsertMenu (menu
, -1);
1828 /* Display the menu. */
1829 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
1830 menu_item_selection
= LoWord (menu_item_choice
);
1832 /* Get the refcon to find the correct item*/
1833 if (menu_item_selection
)
1835 menu
= GetMenuHandle (HiWord (menu_item_choice
));
1837 GetMenuItemRefCon (menu
, menu_item_selection
, &refcon
);
1842 /* Clean up extraneous mouse events which might have been generated
1844 discard_mouse_events ();
1847 /* Free the widget_value objects we used to specify the
1849 free_menubar_widget_value_tree (first_wv
);
1851 /* delete all menus */
1853 int i
= MIN_POPUP_SUBMENU_ID
;
1854 MenuHandle submenu
= GetMenuHandle (i
);
1855 while (menu
!= NULL
)
1859 menu
= GetMenuHandle (++i
);
1863 DeleteMenu (POPUP_SUBMENU_ID
);
1866 /* Find the selected item, and its pane, to return
1867 the proper value. */
1868 if (menu_item_selection
!= 0)
1870 Lisp_Object prefix
, entry
;
1872 prefix
= entry
= Qnil
;
1874 while (i
< menu_items_used
)
1876 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1878 subprefix_stack
[submenu_depth
++] = prefix
;
1882 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1884 prefix
= subprefix_stack
[--submenu_depth
];
1887 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1890 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1891 i
+= MENU_ITEMS_PANE_LENGTH
;
1893 /* Ignore a nil in the item list.
1894 It's meaningful only for dialog boxes. */
1895 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1900 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1901 if ((int) (EMACS_INT
) refcon
== i
)
1907 entry
= Fcons (entry
, Qnil
);
1909 entry
= Fcons (prefix
, entry
);
1910 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1911 if (!NILP (subprefix_stack
[j
]))
1912 entry
= Fcons (subprefix_stack
[j
], entry
);
1916 i
+= MENU_ITEMS_ITEM_LENGTH
;
1926 /* Construct native Mac OS menubar based on widget_value tree. */
1929 mac_dialog (widget_value
*wv
)
1933 char **button_labels
;
1940 WindowPtr window_ptr
;
1943 EventRecord event_record
;
1945 int control_part_code
;
1948 dialog_name
= wv
->name
;
1949 nb_buttons
= dialog_name
[1] - '0';
1950 left_count
= nb_buttons
- (dialog_name
[4] - '0');
1951 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
1952 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
1955 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
1956 strcpy (prompt
, wv
->value
);
1960 for (i
= 0; i
< nb_buttons
; i
++)
1962 button_labels
[i
] = wv
->value
;
1963 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
1964 strcpy (button_labels
[i
], wv
->value
);
1965 c2pstr (button_labels
[i
]);
1966 ref_cons
[i
] = (UInt32
) wv
->call_data
;
1970 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
1972 #if TARGET_API_MAC_CARBON
1973 SetPort (GetWindowPort (window_ptr
));
1975 SetPort (window_ptr
);
1979 /* Left and right margins in the dialog are 13 pixels each.*/
1981 /* Calculate width of dialog box: 8 pixels on each side of the text
1982 label in each button, 12 pixels between buttons. */
1983 for (i
= 0; i
< nb_buttons
; i
++)
1984 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1986 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1989 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
1991 SizeWindow (window_ptr
, dialog_width
, 78, 0);
1992 ShowWindow (window_ptr
);
1994 #if TARGET_API_MAC_CARBON
1995 SetPort (GetWindowPort (window_ptr
));
1997 SetPort (window_ptr
);
2003 DrawString (prompt
);
2006 for (i
= 0; i
< nb_buttons
; i
++)
2008 int button_width
= StringWidth (button_labels
[i
]) + 16;
2009 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
2010 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
2011 kControlPushButtonProc
, ref_cons
[i
]);
2012 left
+= button_width
+ 12;
2013 if (i
== left_count
- 1)
2020 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
2021 if (event_record
.what
== mouseDown
)
2023 part_code
= FindWindow (event_record
.where
, &window_ptr
);
2024 if (part_code
== inContent
)
2026 mouse
= event_record
.where
;
2027 GlobalToLocal (&mouse
);
2028 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2029 if (control_part_code
== kControlButtonPart
)
2030 if (TrackControl (ch
, mouse
, NULL
))
2031 i
= GetControlReference (ch
);
2036 DisposeWindow (window_ptr
);
2041 static char * button_names
[] = {
2042 "button1", "button2", "button3", "button4", "button5",
2043 "button6", "button7", "button8", "button9", "button10" };
2046 mac_dialog_show (f
, keymaps
, title
, error
)
2052 int i
, nb_buttons
=0;
2053 char dialog_name
[6];
2054 int menu_item_selection
;
2056 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2058 /* Number of elements seen so far, before boundary. */
2060 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2061 int boundary_seen
= 0;
2065 if (menu_items_n_panes
> 1)
2067 *error
= "Multiple panes in dialog box";
2071 /* Create a tree of widget_value objects
2072 representing the text label and buttons. */
2074 Lisp_Object pane_name
, prefix
;
2076 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2077 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2078 pane_string
= (NILP (pane_name
)
2079 ? "" : (char *) SDATA (pane_name
));
2080 prev_wv
= xmalloc_widget_value ();
2081 prev_wv
->value
= pane_string
;
2082 if (keymaps
&& !NILP (prefix
))
2084 prev_wv
->enabled
= 1;
2085 prev_wv
->name
= "message";
2086 prev_wv
->help
= Qnil
;
2089 /* Loop over all panes and items, filling in the tree. */
2090 i
= MENU_ITEMS_PANE_LENGTH
;
2091 while (i
< menu_items_used
)
2094 /* Create a new item within current pane. */
2095 Lisp_Object item_name
, enable
, descrip
, help
;
2097 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2098 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2100 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2101 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2103 if (NILP (item_name
))
2105 free_menubar_widget_value_tree (first_wv
);
2106 *error
= "Submenu in dialog items";
2109 if (EQ (item_name
, Qquote
))
2111 /* This is the boundary between left-side elts
2112 and right-side elts. Stop incrementing right_count. */
2117 if (nb_buttons
>= 9)
2119 free_menubar_widget_value_tree (first_wv
);
2120 *error
= "Too many dialog items";
2124 wv
= xmalloc_widget_value ();
2126 wv
->name
= (char *) button_names
[nb_buttons
];
2127 if (!NILP (descrip
))
2128 wv
->key
= (char *) SDATA (descrip
);
2129 wv
->value
= (char *) SDATA (item_name
);
2130 wv
->call_data
= (void *) i
;
2131 /* menu item is identified by its index in menu_items table */
2132 wv
->enabled
= !NILP (enable
);
2136 if (! boundary_seen
)
2140 i
+= MENU_ITEMS_ITEM_LENGTH
;
2143 /* If the boundary was not specified,
2144 by default put half on the left and half on the right. */
2145 if (! boundary_seen
)
2146 left_count
= nb_buttons
- nb_buttons
/ 2;
2148 wv
= xmalloc_widget_value ();
2149 wv
->name
= dialog_name
;
2152 /* Dialog boxes use a really stupid name encoding
2153 which specifies how many buttons to use
2154 and how many buttons are on the right.
2155 The Q means something also. */
2156 dialog_name
[0] = 'Q';
2157 dialog_name
[1] = '0' + nb_buttons
;
2158 dialog_name
[2] = 'B';
2159 dialog_name
[3] = 'R';
2160 /* Number of buttons to put on the right. */
2161 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2163 wv
->contents
= first_wv
;
2167 /* Actually create the dialog. */
2169 menu_item_selection
= mac_dialog (first_wv
);
2171 menu_item_selection
= 0;
2174 /* Free the widget_value objects we used to specify the contents. */
2175 free_menubar_widget_value_tree (first_wv
);
2177 /* Find the selected item, and its pane, to return the proper
2179 if (menu_item_selection
!= 0)
2185 while (i
< menu_items_used
)
2189 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2192 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2193 i
+= MENU_ITEMS_PANE_LENGTH
;
2198 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2199 if (menu_item_selection
== i
)
2203 entry
= Fcons (entry
, Qnil
);
2205 entry
= Fcons (prefix
, entry
);
2209 i
+= MENU_ITEMS_ITEM_LENGTH
;
2216 #endif /* HAVE_DIALOGS */
2219 /* Is this item a separator? */
2221 name_is_separator (name
)
2226 /* Check if name string consists of only dashes ('-'). */
2227 while (*name
== '-') name
++;
2228 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2229 or "--deep-shadow". We don't implement them yet, se we just treat
2230 them like normal separators. */
2231 return (*name
== '\0' || start
+ 2 == name
);
2235 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
,
2241 if (name_is_separator (wv
->name
))
2242 AppendMenu (menu
, "\p-");
2245 AppendMenu (menu
, "\pX");
2247 #if TARGET_API_MAC_CARBON
2248 pos
= CountMenuItems (menu
);
2250 pos
= CountMItems (menu
);
2253 strcpy (item_name
, "");
2254 strncat (item_name
, wv
->name
, 255);
2255 if (wv
->key
!= NULL
)
2257 strncat (item_name
, " ", 255);
2258 strncat (item_name
, wv
->key
, 255);
2262 SetMenuItemText (menu
, pos
, item_name
);
2264 if (wv
->enabled
&& !force_disable
)
2265 #if TARGET_API_MAC_CARBON
2266 EnableMenuItem (menu
, pos
);
2268 EnableItem (menu
, pos
);
2271 #if TARGET_API_MAC_CARBON
2272 DisableMenuItem (menu
, pos
);
2274 DisableItem (menu
, pos
);
2277 /* Draw radio buttons and tickboxes. */
2279 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2280 wv
->button_type
== BUTTON_TYPE_RADIO
))
2281 SetItemMark (menu
, pos
, checkMark
);
2283 SetItemMark (menu
, pos
, noMark
);
2287 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2289 if (submenu
!= NULL
)
2290 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2293 /* Construct native Mac OS menubar based on widget_value tree. */
2296 fill_submenu (MenuHandle menu
, widget_value
*wv
)
2298 for ( ; wv
!= NULL
; wv
= wv
->next
)
2301 int cur_submenu
= submenu_id
++;
2302 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2303 fill_submenu (submenu
, wv
->contents
);
2304 InsertMenu (submenu
, -1);
2305 add_menu_item (menu
, wv
, cur_submenu
, 0);
2308 add_menu_item (menu
, wv
, NULL
, 0);
2312 /* Construct native Mac OS menu based on widget_value tree. */
2315 fill_menu (MenuHandle menu
, widget_value
*wv
)
2317 for ( ; wv
!= NULL
; wv
= wv
->next
)
2320 int cur_submenu
= submenu_id
++;
2321 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2322 fill_submenu (submenu
, wv
->contents
);
2323 InsertMenu (submenu
, -1);
2324 add_menu_item (menu
, wv
, cur_submenu
, 0);
2327 add_menu_item (menu
, wv
, NULL
, 0);
2330 /* Construct native Mac OS menubar based on widget_value tree. */
2333 fill_menubar (widget_value
*wv
)
2337 submenu_id
= MIN_SUBMENU_ID
;
2339 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2344 strncpy (title
, wv
->name
, 255);
2347 menu
= NewMenu (id
, title
);
2350 fill_menu (menu
, wv
->contents
);
2352 InsertMenu (menu
, 0);
2356 #endif /* HAVE_MENUS */
2362 staticpro (&menu_items
);
2365 Qdebug_on_next_call
= intern ("debug-on-next-call");
2366 staticpro (&Qdebug_on_next_call
);
2368 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2369 doc
: /* Frame for which we are updating a menu.
2370 The enable predicate for a menu command should check this variable. */);
2371 Vmenu_updating_frame
= Qnil
;
2373 defsubr (&Sx_popup_menu
);
2375 defsubr (&Sx_popup_dialog
);