1 /* Menu support for GNU Emacs on the for Mac OS.
2 Copyright (C) 2000 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@users.sourceforge.net). */
28 #include "termhooks.h"
32 #include "blockinput.h"
39 #include <QuickDraw.h>
40 #include <ToolUtils.h>
45 #if defined (__MRC__) || defined (CODEWARRIOR_VERSION_6)
46 #include <ControlDefinitions.h>
49 /* This may include sys/types.h, and that somehow loses
50 if this is not done before the other system files. */
53 /* Load sys/types.h if not already loaded.
54 In some systems loading it twice is suicidal. */
56 #include <sys/types.h>
59 #include "dispextern.h"
61 #define POPUP_SUBMENU_ID 235
62 #define MIN_MENU_ID 256
63 #define MIN_SUBMENU_ID 1
65 #define DIALOG_WINDOW_RESOURCE 130
67 #define HAVE_DIALOGS 1
69 #undef HAVE_MULTILINGUAL_MENU
71 /******************************************************************/
72 /* Definitions copied from lwlib.h */
74 typedef void * XtPointer
;
86 typedef struct _widget_value
90 /* value (meaning depend on widget type) */
92 /* keyboard equivalent. no implications for XtTranslations */
94 /* Help string or null if none. */
98 /* true if selected */
100 /* The type of a button. */
101 enum button_type button_type
;
102 /* true if menu title */
105 /* true if was edited (maintained by get_value) */
107 /* true if has changed (maintained by lw library) */
109 /* true if this widget itself has changed,
110 but not counting the other widgets found in the `next' field. */
111 change_type this_one_change
;
113 /* Contents of the sub-widgets, also selected slot for checkbox */
114 struct _widget_value
* contents
;
115 /* data passed to callback */
117 /* next one in the list */
118 struct _widget_value
* next
;
120 /* slot for the toolkit dependent part. Always initialize to NULL. */
122 /* tell us if we should free the toolkit data slot when freeing the
123 widget_value itself. */
124 Boolean free_toolkit_data
;
126 /* we resource the widget_value structures; this points to the next
127 one on the free list if this one has been deallocated.
129 struct _widget_value
*free_list
;
133 /* Assumed by other routines to zero area returned. */
134 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
135 0, (sizeof (widget_value)))
136 #define free_widget_value(wv) xfree (wv)
138 /******************************************************************/
140 #define min(x,y) (((x) < (y)) ? (x) : (y))
141 #define max(x,y) (((x) > (y)) ? (x) : (y))
148 Lisp_Object Vmenu_updating_frame
;
150 Lisp_Object Qdebug_on_next_call
;
152 extern Lisp_Object Qmenu_bar
;
153 extern Lisp_Object Qmouse_click
, Qevent_kind
;
155 extern Lisp_Object QCtoggle
, QCradio
;
157 extern Lisp_Object Voverriding_local_map
;
158 extern Lisp_Object Voverriding_local_map_menu_flag
;
160 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
162 extern Lisp_Object Qmenu_bar_update_hook
;
164 void set_frame_menubar ();
166 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
167 Lisp_Object
, Lisp_Object
, Lisp_Object
,
168 Lisp_Object
, Lisp_Object
));
169 static Lisp_Object
mac_dialog_show ();
170 static Lisp_Object
mac_menu_show ();
172 static void keymap_panes ();
173 static void single_keymap_panes ();
174 static void single_menu_item ();
175 static void list_of_panes ();
176 static void list_of_items ();
178 static void fill_submenu (MenuHandle
, widget_value
*, int);
179 static void fill_menubar (widget_value
*);
182 /* This holds a Lisp vector that holds the results of decoding
183 the keymaps or alist-of-alists that specify a menu.
185 It describes the panes and items within the panes.
187 Each pane is described by 3 elements in the vector:
188 t, the pane name, the pane's prefix key.
189 Then follow the pane's items, with 5 elements per item:
190 the item string, the enable flag, the item's value,
191 the definition, and the equivalent keyboard key's description string.
193 In some cases, multiple levels of menus may be described.
194 A single vector slot containing nil indicates the start of a submenu.
195 A single vector slot containing lambda indicates the end of a submenu.
196 The submenu follows a menu item which is the way to reach the submenu.
198 A single vector slot containing quote indicates that the
199 following items should appear on the right of a dialog box.
201 Using a Lisp vector to hold this information while we decode it
202 takes care of protecting all the data from GC. */
204 #define MENU_ITEMS_PANE_NAME 1
205 #define MENU_ITEMS_PANE_PREFIX 2
206 #define MENU_ITEMS_PANE_LENGTH 3
210 MENU_ITEMS_ITEM_NAME
= 0,
211 MENU_ITEMS_ITEM_ENABLE
,
212 MENU_ITEMS_ITEM_VALUE
,
213 MENU_ITEMS_ITEM_EQUIV_KEY
,
214 MENU_ITEMS_ITEM_DEFINITION
,
215 MENU_ITEMS_ITEM_TYPE
,
216 MENU_ITEMS_ITEM_SELECTED
,
217 MENU_ITEMS_ITEM_HELP
,
218 MENU_ITEMS_ITEM_LENGTH
221 static Lisp_Object menu_items
;
223 /* Number of slots currently allocated in menu_items. */
224 static int menu_items_allocated
;
226 /* This is the index in menu_items of the first empty slot. */
227 static int menu_items_used
;
229 /* The number of panes currently recorded in menu_items,
230 excluding those within submenus. */
231 static int menu_items_n_panes
;
233 /* Current depth within submenus. */
234 static int menu_items_submenu_depth
;
236 /* Flag which when set indicates a dialog or menu has been posted by
237 Xt on behalf of one of the widget sets. */
238 static int popup_activated_flag
;
240 static int next_menubar_widget_id
;
242 /* This is set nonzero after the user activates the menu bar, and set
243 to zero again after the menu bars are redisplayed by prepare_menu_bar.
244 While it is nonzero, all calls to set_frame_menubar go deep.
246 I don't understand why this is needed, but it does seem to be
247 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
249 int pending_menu_activation
;
251 /* Initialize the menu_items structure if we haven't already done so.
252 Also mark it as currently empty. */
257 if (NILP (menu_items
))
259 menu_items_allocated
= 60;
260 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
264 menu_items_n_panes
= 0;
265 menu_items_submenu_depth
= 0;
268 /* Call at the end of generating the data in menu_items.
269 This fills in the number of items in the last pane. */
276 /* Call when finished using the data for the current menu
280 discard_menu_items ()
282 /* Free the structure if it is especially large.
283 Otherwise, hold on to it, to save time. */
284 if (menu_items_allocated
> 200)
287 menu_items_allocated
= 0;
291 /* Make the menu_items vector twice as large. */
297 int old_size
= menu_items_allocated
;
300 menu_items_allocated
*= 2;
301 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
302 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
303 old_size
* sizeof (Lisp_Object
));
306 /* Begin a submenu. */
309 push_submenu_start ()
311 if (menu_items_used
+ 1 > menu_items_allocated
)
314 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
315 menu_items_submenu_depth
++;
323 if (menu_items_used
+ 1 > menu_items_allocated
)
326 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
327 menu_items_submenu_depth
--;
330 /* Indicate boundary between left and right. */
333 push_left_right_boundary ()
335 if (menu_items_used
+ 1 > menu_items_allocated
)
338 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
341 /* Start a new menu pane in menu_items..
342 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
345 push_menu_pane (name
, prefix_vec
)
346 Lisp_Object name
, prefix_vec
;
348 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
351 if (menu_items_submenu_depth
== 0)
352 menu_items_n_panes
++;
353 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
354 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
355 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
358 /* Push one menu item into the current pane. NAME is the string to
359 display. ENABLE if non-nil means this item can be selected. KEY
360 is the key generated by choosing this item, or nil if this item
361 doesn't really have a definition. DEF is the definition of this
362 item. EQUIV is the textual description of the keyboard equivalent
363 for this item (or nil if none). TYPE is the type of this menu
364 item, one of nil, `toggle' or `radio'. */
367 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
368 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
370 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
376 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
377 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
378 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
379 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
380 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
383 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
384 and generate menu panes for them in menu_items.
385 If NOTREAL is nonzero,
386 don't bother really computing whether an item is enabled. */
389 keymap_panes (keymaps
, nmaps
, notreal
)
390 Lisp_Object
*keymaps
;
398 /* Loop over the given keymaps, making a pane for each map.
399 But don't make a pane that is empty--ignore that map instead.
400 P is the number of panes we have made so far. */
401 for (mapno
= 0; mapno
< nmaps
; mapno
++)
402 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
, 10);
404 finish_menu_items ();
407 /* This is a recursive subroutine of keymap_panes.
408 It handles one keymap, KEYMAP.
409 The other arguments are passed along
410 or point to local variables of the previous function.
411 If NOTREAL is nonzero, only check for equivalent key bindings, don't
412 evaluate expressions in menu items and don't make any menu.
414 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
417 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
419 Lisp_Object pane_name
;
424 Lisp_Object pending_maps
= Qnil
;
425 Lisp_Object tail
, item
;
426 struct gcpro gcpro1
, gcpro2
;
431 push_menu_pane (pane_name
, prefix
);
433 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
435 GCPRO2 (keymap
, pending_maps
);
436 /* Look at each key binding, and if it is a menu item add it
440 single_menu_item (XCAR (item
), XCDR (item
),
441 &pending_maps
, notreal
, maxdepth
);
442 else if (VECTORP (item
))
444 /* Loop over the char values represented in the vector. */
445 int len
= XVECTOR (item
)->size
;
447 for (c
= 0; c
< len
; c
++)
449 Lisp_Object character
;
450 XSETFASTINT (character
, c
);
451 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
452 &pending_maps
, notreal
, maxdepth
);
458 /* Process now any submenus which want to be panes at this level. */
459 while (!NILP (pending_maps
))
461 Lisp_Object elt
, eltcdr
, string
;
462 elt
= Fcar (pending_maps
);
464 string
= XCAR (eltcdr
);
465 /* We no longer discard the @ from the beginning of the string here.
466 Instead, we do this in mac_menu_show. */
467 single_keymap_panes (Fcar (elt
), string
,
468 XCDR (eltcdr
), notreal
, maxdepth
- 1);
469 pending_maps
= Fcdr (pending_maps
);
473 /* This is a subroutine of single_keymap_panes that handles one
475 KEY is a key in a keymap and ITEM is its binding.
476 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
478 If NOTREAL is nonzero, only check for equivalent key bindings, don't
479 evaluate expressions in menu items and don't make any menu.
480 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
483 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
484 Lisp_Object key
, item
;
485 Lisp_Object
*pending_maps_ptr
;
486 int maxdepth
, notreal
;
488 Lisp_Object map
, item_string
, enabled
;
489 struct gcpro gcpro1
, gcpro2
;
492 /* Parse the menu item and leave the result in item_properties. */
494 res
= parse_menu_item (item
, notreal
, 0);
497 return; /* Not a menu item. */
499 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
503 /* We don't want to make a menu, just traverse the keymaps to
504 precompute equivalent key bindings. */
506 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
510 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
511 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
513 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
516 /* An enabled separate pane. Remember this to handle it later. */
517 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
522 push_menu_item (item_string
, enabled
, key
,
523 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
524 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
525 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
526 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
527 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
529 /* Display a submenu using the toolkit. */
530 if (! (NILP (map
) || NILP (enabled
)))
532 push_submenu_start ();
533 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
538 /* Push all the panes and items of a menu described by the
539 alist-of-alists MENU.
540 This handles old-fashioned calls to x-popup-menu. */
550 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
552 Lisp_Object elt
, pane_name
, pane_data
;
554 pane_name
= Fcar (elt
);
555 CHECK_STRING (pane_name
, 0);
556 push_menu_pane (pane_name
, Qnil
);
557 pane_data
= Fcdr (elt
);
558 CHECK_CONS (pane_data
, 0);
559 list_of_items (pane_data
);
562 finish_menu_items ();
565 /* Push the items in a single pane defined by the alist PANE. */
571 Lisp_Object tail
, item
, item1
;
573 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
577 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
578 else if (NILP (item
))
579 push_left_right_boundary ();
582 CHECK_CONS (item
, 0);
584 CHECK_STRING (item1
, 1);
585 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
590 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
591 "Pop up a deck-of-cards menu and return user's selection.\n\
592 POSITION is a position specification. This is either a mouse button event\n\
593 or a list ((XOFFSET YOFFSET) WINDOW)\n\
594 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
595 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
596 This controls the position of the center of the first line\n\
597 in the first pane of the menu, not the top left of the menu as a whole.\n\
598 If POSITION is t, it means to use the current mouse position.\n\
600 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
601 The menu items come from key bindings that have a menu string as well as\n\
602 a definition; actually, the \"definition\" in such a key binding looks like\n\
603 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
604 the keymap as a top-level element.\n\n\
605 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
606 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
608 You can also use a list of keymaps as MENU.\n\
609 Then each keymap makes a separate pane.\n\
610 When MENU is a keymap or a list of keymaps, the return value\n\
611 is a list of events.\n\n\
613 Alternatively, you can specify a menu of multiple panes\n\
614 with a list of the form (TITLE PANE1 PANE2...),\n\
615 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
616 Each ITEM is normally a cons cell (STRING . VALUE);\n\
617 but a string can appear as an item--that makes a nonselectable line\n\
619 With this form of menu, the return value is VALUE from the chosen item.\n\
621 If POSITION is nil, don't display the menu at all, just precalculate the\n\
622 cached information about equivalent key sequences.")
624 Lisp_Object position
, menu
;
626 Lisp_Object keymap
, tem
;
630 Lisp_Object selection
;
632 Lisp_Object x
, y
, window
;
638 if (! NILP (position
))
642 /* Decode the first argument: find the window and the coordinates. */
643 if (EQ (position
, Qt
)
644 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
646 /* Use the mouse's current position. */
647 FRAME_PTR new_f
= SELECTED_FRAME ();
648 Lisp_Object bar_window
;
649 enum scroll_bar_part part
;
652 if (mouse_position_hook
)
653 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
654 &part
, &x
, &y
, &time
);
656 XSETFRAME (window
, new_f
);
659 window
= selected_window
;
666 tem
= Fcar (position
);
669 window
= Fcar (Fcdr (position
));
671 y
= Fcar (Fcdr (tem
));
676 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
677 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
678 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
687 /* Decode where to put the menu. */
695 else if (WINDOWP (window
))
697 CHECK_LIVE_WINDOW (window
, 0);
698 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
700 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
701 * XFASTINT (XWINDOW (window
)->left
));
702 ypos
= (FRAME_LINE_HEIGHT (f
)
703 * XFASTINT (XWINDOW (window
)->top
));
706 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
707 but I don't want to make one now. */
708 CHECK_WINDOW (window
, 0);
713 XSETFRAME (Vmenu_updating_frame
, f
);
715 Vmenu_updating_frame
= Qnil
;
716 #endif /* HAVE_MENUS */
721 /* Decode the menu items from what was specified. */
723 keymap
= Fkeymapp (menu
);
726 tem
= Fkeymapp (Fcar (menu
));
729 /* We were given a keymap. Extract menu info from the keymap. */
731 keymap
= get_keymap (menu
);
733 /* Extract the detailed info to make one pane. */
734 keymap_panes (&menu
, 1, NILP (position
));
736 /* Search for a string appearing directly as an element of the keymap.
737 That string is the title of the menu. */
738 prompt
= map_prompt (keymap
);
739 if (NILP (title
) && !NILP (prompt
))
742 /* Make that be the pane title of the first pane. */
743 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
744 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
748 else if (!NILP (tem
))
750 /* We were given a list of keymaps. */
751 int nmaps
= XFASTINT (Flength (menu
));
753 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
758 /* The first keymap that has a prompt string
759 supplies the menu title. */
760 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
764 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
766 prompt
= map_prompt (keymap
);
767 if (NILP (title
) && !NILP (prompt
))
771 /* Extract the detailed info to make one pane. */
772 keymap_panes (maps
, nmaps
, NILP (position
));
774 /* Make the title be the pane title of the first pane. */
775 if (!NILP (title
) && menu_items_n_panes
>= 0)
776 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
782 /* We were given an old-fashioned menu. */
784 CHECK_STRING (title
, 1);
786 list_of_panes (Fcdr (menu
));
793 discard_menu_items ();
799 /* Display them in a menu. */
802 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
803 keymaps
, title
, &error_name
);
806 discard_menu_items ();
809 #endif /* HAVE_MENUS */
811 if (error_name
) error (error_name
);
817 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
818 "Pop up a dialog box and return user's selection.\n\
819 POSITION specifies which frame to use.\n\
820 This is normally a mouse button event or a window or frame.\n\
821 If POSITION is t, it means to use the frame the mouse is on.\n\
822 The dialog box appears in the middle of the specified frame.\n\
824 CONTENTS specifies the alternatives to display in the dialog box.\n\
825 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
826 Each ITEM is a cons cell (STRING . VALUE).\n\
827 The return value is VALUE from the chosen item.\n\n\
828 An ITEM may also be just a string--that makes a nonselectable item.\n\
829 An ITEM may also be nil--that means to put all preceding items\n\
830 on the left of the dialog box and all following items on the right.\n\
831 \(By default, approximately half appear on each side.)")
833 Lisp_Object position
, contents
;
840 /* Decode the first argument: find the window or frame to use. */
841 if (EQ (position
, Qt
)
842 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
844 #if 0 /* Using the frame the mouse is on may not be right. */
845 /* Use the mouse's current position. */
846 FRAME_PTR new_f
= SELECTED_FRAME ();
847 Lisp_Object bar_window
;
852 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
855 XSETFRAME (window
, new_f
);
857 window
= selected_window
;
859 window
= selected_window
;
861 else if (CONSP (position
))
864 tem
= Fcar (position
);
866 window
= Fcar (Fcdr (position
));
869 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
870 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
873 else if (WINDOWP (position
) || FRAMEP (position
))
878 /* Decode where to put the menu. */
882 else if (WINDOWP (window
))
884 CHECK_LIVE_WINDOW (window
, 0);
885 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
888 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
889 but I don't want to make one now. */
890 CHECK_WINDOW (window
, 0);
893 /* Display a menu with these alternatives
894 in the middle of frame F. */
896 Lisp_Object x
, y
, frame
, newpos
;
897 XSETFRAME (frame
, f
);
898 XSETINT (x
, x_pixel_width (f
) / 2);
899 XSETINT (y
, x_pixel_height (f
) / 2);
900 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
902 return Fx_popup_menu (newpos
,
903 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
905 #else /* HAVE_DIALOGS */
909 Lisp_Object selection
;
911 /* Decode the dialog items from what was specified. */
912 title
= Fcar (contents
);
913 CHECK_STRING (title
, 1);
915 list_of_panes (Fcons (contents
, Qnil
));
917 /* Display them in a dialog box. */
919 selection
= mac_dialog_show (f
, 0, title
, &error_name
);
922 discard_menu_items ();
924 if (error_name
) error (error_name
);
927 #endif /* HAVE_DIALOGS */
930 /* Activate the menu bar of frame F.
931 This is called from keyboard.c when it gets the
932 menu_bar_activate_event out of the Emacs event queue.
934 To activate the menu bar, we signal to the input thread that it can
935 return from the WM_INITMENU message, allowing the normal Windows
936 processing of the menus.
938 But first we recompute the menu bar contents (the whole tree).
940 This way we can safely execute Lisp code. */
943 x_activate_menubar (f
)
947 extern Point saved_menu_event_location
;
949 set_frame_menubar (f
, 0, 1);
952 menu_choice
= MenuSelect (saved_menu_event_location
);
953 do_menu_choice (menu_choice
);
958 /* This callback is called from the menu bar pulldown menu
959 when the user makes a selection.
960 Figure out what the user chose
961 and put the appropriate events into the keyboard buffer. */
964 menubar_selection_callback (FRAME_PTR f
, int client_data
)
966 Lisp_Object prefix
, entry
;
968 Lisp_Object
*subprefix_stack
;
969 int submenu_depth
= 0;
974 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
975 vector
= f
->menu_bar_vector
;
978 while (i
< f
->menu_bar_items_used
)
980 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
982 subprefix_stack
[submenu_depth
++] = prefix
;
986 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
988 prefix
= subprefix_stack
[--submenu_depth
];
991 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
993 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
994 i
+= MENU_ITEMS_PANE_LENGTH
;
998 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
999 if (client_data
== i
)
1002 struct input_event buf
;
1005 XSETFRAME (frame
, f
);
1006 buf
.kind
= MENU_BAR_EVENT
;
1007 buf
.frame_or_window
= frame
;
1009 kbd_buffer_store_event (&buf
);
1011 for (j
= 0; j
< submenu_depth
; j
++)
1012 if (!NILP (subprefix_stack
[j
]))
1014 buf
.kind
= MENU_BAR_EVENT
;
1015 buf
.frame_or_window
= frame
;
1016 buf
.arg
= subprefix_stack
[j
];
1017 kbd_buffer_store_event (&buf
);
1022 buf
.kind
= MENU_BAR_EVENT
;
1023 buf
.frame_or_window
= frame
;
1025 kbd_buffer_store_event (&buf
);
1028 buf
.kind
= MENU_BAR_EVENT
;
1029 buf
.frame_or_window
= frame
;
1031 kbd_buffer_store_event (&buf
);
1034 /* Queue this to recompute possibly updated menubar. */
1035 buf
.kind
= menu_bar_activate_event
;
1036 buf
.frame_or_window
= frame
;
1038 kbd_buffer_store_event (&buf
);
1043 i
+= MENU_ITEMS_ITEM_LENGTH
;
1048 /* Allocate a widget_value, blocking input. */
1051 xmalloc_widget_value ()
1053 widget_value
*value
;
1056 value
= malloc_widget_value ();
1062 /* This recursively calls free_widget_value on the tree of widgets.
1063 It must free all data that was malloc'ed for these widget_values.
1064 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1065 must be left alone. */
1068 free_menubar_widget_value_tree (wv
)
1073 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1075 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1077 free_menubar_widget_value_tree (wv
->contents
);
1078 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1082 free_menubar_widget_value_tree (wv
->next
);
1083 wv
->next
= (widget_value
*) 0xDEADBEEF;
1086 free_widget_value (wv
);
1090 /* Return a tree of widget_value structures for a menu bar item
1091 whose event type is ITEM_KEY (with string ITEM_NAME)
1092 and whose contents come from the list of keymaps MAPS. */
1094 static widget_value
*
1095 single_submenu (item_key
, item_name
, maps
)
1096 Lisp_Object item_key
, item_name
, maps
;
1098 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1100 int submenu_depth
= 0;
1103 Lisp_Object
*mapvec
;
1104 widget_value
**submenu_stack
;
1105 int previous_items
= menu_items_used
;
1106 int top_level_items
= 0;
1108 length
= Flength (maps
);
1109 len
= XINT (length
);
1111 /* Convert the list MAPS into a vector MAPVEC. */
1112 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1113 for (i
= 0; i
< len
; i
++)
1115 mapvec
[i
] = Fcar (maps
);
1119 menu_items_n_panes
= 0;
1121 /* Loop over the given keymaps, making a pane for each map.
1122 But don't make a pane that is empty--ignore that map instead. */
1123 for (i
= 0; i
< len
; i
++)
1125 if (SYMBOLP (mapvec
[i
])
1126 || (CONSP (mapvec
[i
])
1127 && NILP (Fkeymapp (mapvec
[i
]))))
1129 /* Here we have a command at top level in the menu bar
1130 as opposed to a submenu. */
1131 top_level_items
= 1;
1132 push_menu_pane (Qnil
, Qnil
);
1133 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1134 Qnil
, Qnil
, Qnil
, Qnil
);
1137 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1140 /* Create a tree of widget_value objects
1141 representing the panes and their items. */
1144 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1145 wv
= xmalloc_widget_value ();
1149 wv
->button_type
= BUTTON_TYPE_NONE
;
1154 /* Loop over all panes and items made during this call
1155 and construct a tree of widget_value objects.
1156 Ignore the panes and items made by previous calls to
1157 single_submenu, even though those are also in menu_items. */
1159 while (i
< menu_items_used
)
1161 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1163 submenu_stack
[submenu_depth
++] = save_wv
;
1168 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1171 save_wv
= submenu_stack
[--submenu_depth
];
1174 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1175 && submenu_depth
!= 0)
1176 i
+= MENU_ITEMS_PANE_LENGTH
;
1177 /* Ignore a nil in the item list.
1178 It's meaningful only for dialog boxes. */
1179 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1181 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1183 /* Create a new pane. */
1184 Lisp_Object pane_name
, prefix
;
1186 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1187 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1188 #ifndef HAVE_MULTILINGUAL_MENU
1189 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1190 pane_name
= string_make_unibyte (pane_name
);
1192 pane_string
= (NILP (pane_name
)
1193 ? "" : (char *) XSTRING (pane_name
)->data
);
1194 /* If there is just one top-level pane, put all its items directly
1195 under the top-level menu. */
1196 if (menu_items_n_panes
== 1)
1199 /* If the pane has a meaningful name,
1200 make the pane a top-level menu item
1201 with its items as a submenu beneath it. */
1202 if (strcmp (pane_string
, ""))
1204 wv
= xmalloc_widget_value ();
1208 first_wv
->contents
= wv
;
1209 wv
->name
= pane_string
;
1210 /* Ignore the @ that means "separate pane".
1211 This is a kludge, but this isn't worth more time. */
1212 if (!NILP (prefix
) && wv
->name
[0] == '@')
1216 wv
->button_type
= BUTTON_TYPE_NONE
;
1220 i
+= MENU_ITEMS_PANE_LENGTH
;
1224 /* Create a new item within current pane. */
1225 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1228 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1229 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1231 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1232 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1233 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1234 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1235 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1237 #ifndef HAVE_MULTILINGUAL_MENU
1238 if (STRING_MULTIBYTE (item_name
))
1239 item_name
= string_make_unibyte (item_name
);
1240 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1241 descrip
= string_make_unibyte (descrip
);
1244 wv
= xmalloc_widget_value ();
1248 save_wv
->contents
= wv
;
1250 wv
->name
= (char *) XSTRING (item_name
)->data
;
1251 if (!NILP (descrip
))
1252 wv
->key
= (char *) XSTRING (descrip
)->data
;
1254 /* The EMACS_INT cast avoids a warning. There's no problem
1255 as long as pointers have enough bits to hold small integers. */
1256 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1257 wv
->enabled
= !NILP (enable
);
1260 wv
->button_type
= BUTTON_TYPE_NONE
;
1261 else if (EQ (type
, QCradio
))
1262 wv
->button_type
= BUTTON_TYPE_RADIO
;
1263 else if (EQ (type
, QCtoggle
))
1264 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1268 wv
->selected
= !NILP (selected
);
1270 wv
->help
= (char *) XSTRING (help
)->data
;
1276 i
+= MENU_ITEMS_ITEM_LENGTH
;
1280 /* If we have just one "menu item"
1281 that was originally a button, return it by itself. */
1282 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1284 wv
= first_wv
->contents
;
1285 free_widget_value (first_wv
);
1292 /* Set the contents of the menubar widgets of frame F.
1293 The argument FIRST_TIME is currently ignored;
1294 it is set the first time this is called, from initialize_frame_menubar. */
1297 set_frame_menubar (f
, first_time
, deep_p
)
1302 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1304 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1307 XSETFRAME (Vmenu_updating_frame
, f
);
1309 wv
= xmalloc_widget_value ();
1310 wv
->name
= "menubar";
1313 wv
->button_type
= BUTTON_TYPE_NONE
;
1317 /* Make a widget-value tree representing the entire menu trees. */
1319 struct buffer
*prev
= current_buffer
;
1321 int specpdl_count
= specpdl_ptr
- specpdl
;
1322 int previous_menu_items_used
= f
->menu_bar_items_used
;
1323 Lisp_Object
*previous_items
1324 = (Lisp_Object
*) alloca (previous_menu_items_used
1325 * sizeof (Lisp_Object
));
1327 /* If we are making a new widget, its contents are empty,
1328 do always reinitialize them. */
1329 if (! menubar_widget
)
1330 previous_menu_items_used
= 0;
1332 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1333 specbind (Qinhibit_quit
, Qt
);
1334 /* Don't let the debugger step into this code
1335 because it is not reentrant. */
1336 specbind (Qdebug_on_next_call
, Qnil
);
1338 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1339 if (NILP (Voverriding_local_map_menu_flag
))
1341 specbind (Qoverriding_terminal_local_map
, Qnil
);
1342 specbind (Qoverriding_local_map
, Qnil
);
1345 set_buffer_internal_1 (XBUFFER (buffer
));
1347 /* Run the Lucid hook. */
1348 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1349 /* If it has changed current-menubar from previous value,
1350 really recompute the menubar from the value. */
1351 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1352 call0 (Qrecompute_lucid_menubar
);
1353 safe_run_hooks (Qmenu_bar_update_hook
);
1354 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1356 items
= FRAME_MENU_BAR_ITEMS (f
);
1358 inhibit_garbage_collection ();
1360 /* Save the frame's previous menu bar contents data. */
1361 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1362 previous_menu_items_used
* sizeof (Lisp_Object
));
1364 /* Fill in the current menu bar contents. */
1365 menu_items
= f
->menu_bar_vector
;
1366 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1368 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1370 Lisp_Object key
, string
, maps
;
1372 key
= XVECTOR (items
)->contents
[i
];
1373 string
= XVECTOR (items
)->contents
[i
+ 1];
1374 maps
= XVECTOR (items
)->contents
[i
+ 2];
1378 wv
= single_submenu (key
, string
, maps
);
1382 first_wv
->contents
= wv
;
1383 /* Don't set wv->name here; GC during the loop might relocate it. */
1385 wv
->button_type
= BUTTON_TYPE_NONE
;
1389 finish_menu_items ();
1391 set_buffer_internal_1 (prev
);
1392 unbind_to (specpdl_count
, Qnil
);
1394 /* If there has been no change in the Lisp-level contents
1395 of the menu bar, skip redisplaying it. Just exit. */
1397 for (i
= 0; i
< previous_menu_items_used
; i
++)
1398 if (menu_items_used
== i
1399 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1401 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1403 free_menubar_widget_value_tree (first_wv
);
1409 /* Now GC cannot happen during the lifetime of the widget_value,
1410 so it's safe to store data from a Lisp_String. */
1411 wv
= first_wv
->contents
;
1412 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1415 string
= XVECTOR (items
)->contents
[i
+ 1];
1418 wv
->name
= (char *) XSTRING (string
)->data
;
1422 f
->menu_bar_vector
= menu_items
;
1423 f
->menu_bar_items_used
= menu_items_used
;
1427 /* Create or update the menu bar widget. */
1431 f
->output_data
.mac
->menubar_widget
= NULL
; /* always NULL on Mac */
1434 int i
= MIN_MENU_ID
;
1435 MenuHandle menu
= GetMenuHandle (i
);
1436 while (menu
!= NULL
)
1440 menu
= GetMenuHandle (++i
);
1444 menu
= GetMenuHandle (i
);
1445 while (menu
!= NULL
)
1449 menu
= GetMenuHandle (++i
);
1453 fill_menubar (first_wv
->contents
);
1457 free_menubar_widget_value_tree (first_wv
);
1462 /* Called from Fx_create_frame to create the initial menubar of a
1463 frame before it is mapped, so that the window is mapped with the
1464 menubar already there instead of us tacking it on later and
1465 thrashing the window after it is visible. */
1468 initialize_frame_menubar (f
)
1471 /* This function is called before the first chance to redisplay
1472 the frame. It has to be, so the frame will have the right size. */
1473 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1474 set_frame_menubar (f
, 1, 1);
1477 /* Get rid of the menu bar of frame F, and free its storage.
1478 This is used when deleting a frame, and when turning off the menu bar. */
1481 free_frame_menubar (f
)
1484 /* Nothing to do since set_frame_menubar disposes of menus before
1485 installing new ones. */
1489 /* mac_menu_show actually displays a menu using the panes and items in
1490 menu_items and returns the value selected from it; we assume input
1491 is blocked by the caller. */
1493 /* F is the frame the menu is for.
1494 X and Y are the frame-relative specified position,
1495 relative to the inside upper left corner of the frame F.
1496 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1497 KEYMAPS is 1 if this menu was specified with keymaps;
1498 in that case, we return a list containing the chosen item's value
1499 and perhaps also the pane's prefix.
1500 TITLE is the specified menu title.
1501 ERROR is a place to store an error message string in case of failure.
1502 (We return nil on failure, but the value doesn't actually matter.) */
1505 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1515 int menu_item_selection
;
1518 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1519 widget_value
**submenu_stack
1520 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1521 Lisp_Object
*subprefix_stack
1522 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1523 int submenu_depth
= 0;
1525 int next_release_must_exit
= 0;
1529 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1531 *error
= "Empty menu";
1535 /* Create a tree of widget_value objects
1536 representing the panes and their items. */
1537 wv
= xmalloc_widget_value ();
1541 wv
->button_type
= BUTTON_TYPE_NONE
;
1545 /* Loop over all panes and items, filling in the tree. */
1547 while (i
< menu_items_used
)
1549 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1551 submenu_stack
[submenu_depth
++] = save_wv
;
1557 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1560 save_wv
= submenu_stack
[--submenu_depth
];
1564 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1565 && submenu_depth
!= 0)
1566 i
+= MENU_ITEMS_PANE_LENGTH
;
1567 /* Ignore a nil in the item list.
1568 It's meaningful only for dialog boxes. */
1569 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1571 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1573 /* Create a new pane. */
1574 Lisp_Object pane_name
, prefix
;
1576 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1577 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1578 #ifndef HAVE_MULTILINGUAL_MENU
1579 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1580 pane_name
= string_make_unibyte (pane_name
);
1582 pane_string
= (NILP (pane_name
)
1583 ? "" : (char *) XSTRING (pane_name
)->data
);
1584 /* If there is just one top-level pane, put all its items directly
1585 under the top-level menu. */
1586 if (menu_items_n_panes
== 1)
1589 /* If the pane has a meaningful name,
1590 make the pane a top-level menu item
1591 with its items as a submenu beneath it. */
1592 if (!keymaps
&& strcmp (pane_string
, ""))
1594 wv
= xmalloc_widget_value ();
1598 first_wv
->contents
= wv
;
1599 wv
->name
= pane_string
;
1600 if (keymaps
&& !NILP (prefix
))
1604 wv
->button_type
= BUTTON_TYPE_NONE
;
1608 else if (first_pane
)
1614 i
+= MENU_ITEMS_PANE_LENGTH
;
1618 /* Create a new item within current pane. */
1619 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1621 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1622 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1624 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1625 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1626 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1627 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1628 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1630 #ifndef HAVE_MULTILINGUAL_MENU
1631 if (STRING_MULTIBYTE (item_name
))
1632 item_name
= string_make_unibyte (item_name
);
1633 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1634 descrip
= string_make_unibyte (descrip
);
1637 wv
= xmalloc_widget_value ();
1641 save_wv
->contents
= wv
;
1642 wv
->name
= (char *) XSTRING (item_name
)->data
;
1643 if (!NILP (descrip
))
1644 wv
->key
= (char *) XSTRING (descrip
)->data
;
1646 /* Use the contents index as call_data, since we are
1647 restricted to 16-bits.. */
1648 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1649 wv
->enabled
= !NILP (enable
);
1652 wv
->button_type
= BUTTON_TYPE_NONE
;
1653 else if (EQ (type
, QCtoggle
))
1654 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1655 else if (EQ (type
, QCradio
))
1656 wv
->button_type
= BUTTON_TYPE_RADIO
;
1660 wv
->selected
= !NILP (selected
);
1663 wv
->help
= (char *) XSTRING (help
)->data
;
1669 i
+= MENU_ITEMS_ITEM_LENGTH
;
1673 /* Deal with the title, if it is non-nil. */
1676 widget_value
*wv_title
= xmalloc_widget_value ();
1677 widget_value
*wv_sep
= xmalloc_widget_value ();
1679 /* Maybe replace this separator with a bitmap or owner-draw item
1680 so that it looks better. Having two separators looks odd. */
1681 wv_sep
->name
= "--";
1682 wv_sep
->next
= first_wv
->contents
;
1684 #ifndef HAVE_MULTILINGUAL_MENU
1685 if (STRING_MULTIBYTE (title
))
1686 title
= string_make_unibyte (title
);
1688 wv_title
->name
= (char *) XSTRING (title
)->data
;
1689 wv_title
->enabled
= True
;
1690 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1691 wv_title
->next
= wv_sep
;
1692 first_wv
->contents
= wv_title
;
1695 /* Actually create the menu. */
1696 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1697 fill_submenu (menu
, first_wv
->contents
, 0);
1699 /* Adjust coordinates to be root-window-relative. */
1702 SetPort (FRAME_MAC_WINDOW (f
));
1703 LocalToGlobal (&pos
);
1705 /* No selection has been chosen yet. */
1706 menu_item_selection
= 0;
1708 InsertMenu (menu
, -1);
1710 /* Display the menu. */
1711 menu_item_selection
= LoWord (PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0));
1713 DeleteMenu (POPUP_SUBMENU_ID
);
1716 /* Clean up extraneous mouse events which might have been generated
1718 discard_mouse_events ();
1721 /* Free the widget_value objects we used to specify the
1723 free_menubar_widget_value_tree (first_wv
);
1727 /* Find the selected item, and its pane, to return the proper
1729 if (menu_item_selection
!= 0)
1731 Lisp_Object prefix
, entry
;
1735 while (i
< menu_items_used
)
1737 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1739 subprefix_stack
[submenu_depth
++] = prefix
;
1743 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1745 prefix
= subprefix_stack
[--submenu_depth
];
1748 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1751 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1752 i
+= MENU_ITEMS_PANE_LENGTH
;
1754 /* Ignore a nil in the item list. It's meaningful only for
1756 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1761 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1762 if (menu_item_selection
== i
)
1768 entry
= Fcons (entry
, Qnil
);
1770 entry
= Fcons (prefix
, entry
);
1771 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1772 if (!NILP (subprefix_stack
[j
]))
1773 entry
= Fcons (subprefix_stack
[j
], entry
);
1777 i
+= MENU_ITEMS_ITEM_LENGTH
;
1786 /* Construct native Mac OS menubar based on widget_value tree. */
1789 mac_dialog (widget_value
*wv
)
1793 char **button_labels
;
1800 WindowPtr window_ptr
;
1803 EventRecord event_record
;
1805 int control_part_code
;
1808 dialog_name
= wv
->name
;
1809 nb_buttons
= dialog_name
[1] - '0';
1810 left_count
= nb_buttons
- (dialog_name
[4] - '0');
1811 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
1812 ref_cons
= (int *) alloca (sizeof (UInt32
) * nb_buttons
);
1815 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
1816 strcpy (prompt
, wv
->value
);
1820 for (i
= 0; i
< nb_buttons
; i
++)
1822 button_labels
[i
] = wv
->value
;
1823 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
1824 strcpy (button_labels
[i
], wv
->value
);
1825 c2pstr (button_labels
[i
]);
1826 ref_cons
[i
] = (UInt32
) wv
->call_data
;
1830 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
1831 SetPort (window_ptr
);
1834 /* Left and right margins in the dialog are 13 pixels each.*/
1836 /* Calculate width of dialog box: 8 pixels on each side of the text
1837 label in each button, 12 pixels between buttons. */
1838 for (i
= 0; i
< nb_buttons
; i
++)
1839 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1841 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1844 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
1846 SizeWindow (window_ptr
, dialog_width
, 78, 0);
1847 ShowWindow (window_ptr
);
1849 SetPort (window_ptr
);
1853 DrawString (prompt
);
1856 for (i
= 0; i
< nb_buttons
; i
++)
1858 int button_width
= StringWidth (button_labels
[i
]) + 16;
1859 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
1860 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
1861 kControlPushButtonProc
, ref_cons
[i
]);
1862 left
+= button_width
+ 12;
1863 if (i
== left_count
- 1)
1870 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
1871 if (event_record
.what
== mouseDown
)
1873 part_code
= FindWindow (event_record
.where
, &window_ptr
);
1874 if (part_code
== inContent
)
1876 mouse
= event_record
.where
;
1877 GlobalToLocal (&mouse
);
1878 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
1879 if (control_part_code
== kControlButtonPart
)
1880 if (TrackControl (ch
, mouse
, NULL
))
1881 i
= GetControlReference (ch
);
1886 DisposeWindow (window_ptr
);
1891 static char * button_names
[] = {
1892 "button1", "button2", "button3", "button4", "button5",
1893 "button6", "button7", "button8", "button9", "button10" };
1896 mac_dialog_show (f
, keymaps
, title
, error
)
1902 int i
, nb_buttons
=0;
1903 char dialog_name
[6];
1904 int menu_item_selection
;
1906 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1908 /* Number of elements seen so far, before boundary. */
1910 /* 1 means we've seen the boundary between left-hand elts and
1912 int boundary_seen
= 0;
1916 if (menu_items_n_panes
> 1)
1918 *error
= "Multiple panes in dialog box";
1922 /* Create a tree of widget_value objects representing the text label
1925 Lisp_Object pane_name
, prefix
;
1927 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1928 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1929 pane_string
= (NILP (pane_name
)
1930 ? "" : (char *) XSTRING (pane_name
)->data
);
1931 prev_wv
= xmalloc_widget_value ();
1932 prev_wv
->value
= pane_string
;
1933 if (keymaps
&& !NILP (prefix
))
1935 prev_wv
->enabled
= 1;
1936 prev_wv
->name
= "message";
1939 /* Loop over all panes and items, filling in the tree. */
1940 i
= MENU_ITEMS_PANE_LENGTH
;
1941 while (i
< menu_items_used
)
1944 /* Create a new item within current pane. */
1945 Lisp_Object item_name
, enable
, descrip
, help
;
1947 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1948 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1950 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1951 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1953 if (NILP (item_name
))
1955 free_menubar_widget_value_tree (first_wv
);
1956 *error
= "Submenu in dialog items";
1959 if (EQ (item_name
, Qquote
))
1961 /* This is the boundary between left-side elts and
1962 right-side elts. Stop incrementing right_count. */
1967 if (nb_buttons
>= 9)
1969 free_menubar_widget_value_tree (first_wv
);
1970 *error
= "Too many dialog items";
1974 wv
= xmalloc_widget_value ();
1976 wv
->name
= (char *) button_names
[nb_buttons
];
1977 if (!NILP (descrip
))
1978 wv
->key
= (char *) XSTRING (descrip
)->data
;
1979 wv
->value
= (char *) XSTRING (item_name
)->data
;
1980 wv
->call_data
= (void *) i
;
1981 /* menu item is identified by its index in menu_items table */
1982 wv
->enabled
= !NILP (enable
);
1985 if (! boundary_seen
)
1989 i
+= MENU_ITEMS_ITEM_LENGTH
;
1992 /* If the boundary was not specified, by default put half on the
1993 left and half on the right. */
1994 if (! boundary_seen
)
1995 left_count
= nb_buttons
- nb_buttons
/ 2;
1997 wv
= xmalloc_widget_value ();
1998 wv
->name
= dialog_name
;
2000 /* Dialog boxes use a really stupid name encoding which specifies
2001 how many buttons to use and how many buttons are on the right.
2002 The Q means something also. */
2003 dialog_name
[0] = 'Q';
2004 dialog_name
[1] = '0' + nb_buttons
;
2005 dialog_name
[2] = 'B';
2006 dialog_name
[3] = 'R';
2007 /* Number of buttons to put on the right. */
2008 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2010 wv
->contents
= first_wv
;
2014 /* Actually create the dialog. */
2016 menu_item_selection
= mac_dialog (first_wv
);
2018 menu_item_selection
= 0;
2021 /* Free the widget_value objects we used to specify the
2023 free_menubar_widget_value_tree (first_wv
);
2025 /* Find the selected item, and its pane, to return the proper
2027 if (menu_item_selection
!= 0)
2033 while (i
< menu_items_used
)
2037 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2040 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2041 i
+= MENU_ITEMS_PANE_LENGTH
;
2046 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2047 if (menu_item_selection
== i
)
2051 entry
= Fcons (entry
, Qnil
);
2053 entry
= Fcons (prefix
, entry
);
2057 i
+= MENU_ITEMS_ITEM_LENGTH
;
2066 /* Is this item a separator? */
2068 name_is_separator (name
)
2071 /* Check if name string consists of only dashes ('-') */
2072 while (*name
== '-') name
++;
2073 return (*name
== '\0');
2077 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
, int indent
,
2083 if (name_is_separator (wv
->name
))
2084 AppendMenu (menu
, "\p-");
2087 AppendMenu (menu
, "\pX");
2089 pos
= CountMItems (menu
);
2091 strcpy (item_name
, "");
2092 for (i
= 0; i
< indent
; i
++)
2093 strcat (item_name
, " ");
2094 strcat (item_name
, wv
->name
);
2095 if (wv
->key
!= NULL
)
2097 strcat (item_name
, " ");
2098 strcat (item_name
, wv
->key
);
2101 SetMenuItemText (menu
, pos
, item_name
);
2103 if (wv
->enabled
&& !force_disable
)
2104 EnableItem (menu
, pos
);
2106 DisableItem (menu
, pos
);
2108 /* Draw radio buttons and tickboxes. */
2110 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2111 wv
->button_type
== BUTTON_TYPE_RADIO
))
2112 SetItemMark (menu
, pos
, checkMark
);
2114 SetItemMark (menu
, pos
, noMark
);
2118 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2120 if (submenu
!= NULL
)
2121 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2124 static int submenu_id
;
2126 /* Construct native Mac OS menubar based on widget_value tree. */
2129 fill_submenu (MenuHandle menu
, widget_value
*wv
, int indent
)
2131 for ( ; wv
!= NULL
; wv
= wv
->next
)
2134 add_menu_item (menu
, wv
, NULL
, indent
, 1);
2136 fill_submenu (menu
, wv
->contents
, indent
+ 1);
2139 add_menu_item (menu
, wv
, NULL
, indent
, 0);
2143 /* Construct native Mac OS menu based on widget_value tree. */
2146 fill_menu (MenuHandle menu
, widget_value
*wv
)
2148 for ( ; wv
!= NULL
; wv
= wv
->next
)
2151 MenuHandle submenu
= NewMenu (submenu_id
, "\pX");
2152 fill_submenu (submenu
, wv
->contents
, 0);
2153 InsertMenu (submenu
, -1);
2154 add_menu_item (menu
, wv
, submenu_id
, 0, 0);
2158 add_menu_item (menu
, wv
, NULL
, 0, 0);
2161 /* Construct native Mac OS menubar based on widget_value tree. */
2164 fill_menubar (widget_value
*wv
)
2168 submenu_id
= MIN_SUBMENU_ID
;
2170 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2175 strcpy (title
, wv
->name
);
2177 menu
= NewMenu (id
, title
);
2180 fill_menu (menu
, wv
->contents
);
2182 InsertMenu (menu
, 0);
2186 #endif /* HAVE_MENUS */
2191 staticpro (&menu_items
);
2194 Qdebug_on_next_call
= intern ("debug-on-next-call");
2195 staticpro (&Qdebug_on_next_call
);
2197 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2198 "Frame for which we are updating a menu.\n\
2199 The enable predicate for a menu command should check this variable.");
2200 Vmenu_updating_frame
= Qnil
;
2202 defsubr (&Sx_popup_menu
);
2204 defsubr (&Sx_popup_dialog
);