1 /* Menu support for GNU Emacs on the for Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Contributed by Andrew Choi (akochoi@mac.com). */
28 #include "termhooks.h"
33 #include "blockinput.h"
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
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
736 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
739 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
740 but I don't want to make one now. */
741 CHECK_WINDOW (window
);
746 XSETFRAME (Vmenu_updating_frame
, f
);
748 Vmenu_updating_frame
= Qnil
;
749 #endif /* HAVE_MENUS */
754 /* Decode the menu items from what was specified. */
756 keymap
= get_keymap (menu
, 0, 0);
759 /* We were given a keymap. Extract menu info from the keymap. */
762 /* Extract the detailed info to make one pane. */
763 keymap_panes (&menu
, 1, NILP (position
));
765 /* Search for a string appearing directly as an element of the keymap.
766 That string is the title of the menu. */
767 prompt
= Fkeymap_prompt (keymap
);
768 if (NILP (title
) && !NILP (prompt
))
771 /* Make that be the pane title of the first pane. */
772 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
773 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
777 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
779 /* We were given a list of keymaps. */
780 int nmaps
= XFASTINT (Flength (menu
));
782 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
787 /* The first keymap that has a prompt string
788 supplies the menu title. */
789 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
793 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
795 prompt
= Fkeymap_prompt (keymap
);
796 if (NILP (title
) && !NILP (prompt
))
800 /* Extract the detailed info to make one pane. */
801 keymap_panes (maps
, nmaps
, NILP (position
));
803 /* Make the title be the pane title of the first pane. */
804 if (!NILP (title
) && menu_items_n_panes
>= 0)
805 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
811 /* We were given an old-fashioned menu. */
813 CHECK_STRING (title
);
815 list_of_panes (Fcdr (menu
));
822 discard_menu_items ();
828 /* Display them in a menu. */
831 selection
= mac_menu_show (f
, xpos
, ypos
, for_click
,
832 keymaps
, title
, &error_name
);
835 discard_menu_items ();
838 #endif /* HAVE_MENUS */
840 if (error_name
) error (error_name
);
846 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
847 doc
: /* Pop up a dialog box and return user's selection.
848 POSITION specifies which frame to use.
849 This is normally a mouse button event or a window or frame.
850 If POSITION is t, it means to use the frame the mouse is on.
851 The dialog box appears in the middle of the specified frame.
853 CONTENTS specifies the alternatives to display in the dialog box.
854 It is a list of the form (TITLE ITEM1 ITEM2...).
855 Each ITEM is a cons cell (STRING . VALUE).
856 The return value is VALUE from the chosen item.
858 An ITEM may also be just a string--that makes a nonselectable item.
859 An ITEM may also be nil--that means to put all preceding items
860 on the left of the dialog box and all following items on the right.
861 \(By default, approximately half appear on each side.) */)
863 Lisp_Object position
, contents
;
870 /* Decode the first argument: find the window or frame to use. */
871 if (EQ (position
, Qt
)
872 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
873 || EQ (XCAR (position
), Qtool_bar
))))
875 #if 0 /* Using the frame the mouse is on may not be right. */
876 /* Use the mouse's current position. */
877 FRAME_PTR new_f
= SELECTED_FRAME ();
878 Lisp_Object bar_window
;
879 enum scroll_bar_part part
;
883 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
886 XSETFRAME (window
, new_f
);
888 window
= selected_window
;
890 window
= selected_window
;
892 else if (CONSP (position
))
895 tem
= Fcar (position
);
897 window
= Fcar (Fcdr (position
));
900 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
901 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
904 else if (WINDOWP (position
) || FRAMEP (position
))
909 /* Decode where to put the menu. */
913 else if (WINDOWP (window
))
915 CHECK_LIVE_WINDOW (window
);
916 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
919 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
920 but I don't want to make one now. */
921 CHECK_WINDOW (window
);
924 /* Display a menu with these alternatives
925 in the middle of frame F. */
927 Lisp_Object x
, y
, frame
, newpos
;
928 XSETFRAME (frame
, f
);
929 XSETINT (x
, x_pixel_width (f
) / 2);
930 XSETINT (y
, x_pixel_height (f
) / 2);
931 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
933 return Fx_popup_menu (newpos
,
934 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
936 #else /* HAVE_DIALOGS */
940 Lisp_Object selection
;
942 /* Decode the dialog items from what was specified. */
943 title
= Fcar (contents
);
944 CHECK_STRING (title
);
946 list_of_panes (Fcons (contents
, Qnil
));
948 /* Display them in a dialog box. */
950 selection
= mac_dialog_show (f
, 0, title
, &error_name
);
953 discard_menu_items ();
955 if (error_name
) error (error_name
);
958 #endif /* HAVE_DIALOGS */
961 /* Activate the menu bar of frame F.
962 This is called from keyboard.c when it gets the
963 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
965 To activate the menu bar, we signal to the input thread that it can
966 return from the WM_INITMENU message, allowing the normal Windows
967 processing of the menus.
969 But first we recompute the menu bar contents (the whole tree).
971 This way we can safely execute Lisp code. */
974 x_activate_menubar (f
)
978 extern Point saved_menu_event_location
;
980 set_frame_menubar (f
, 0, 1);
983 menu_choice
= MenuSelect (saved_menu_event_location
);
984 do_menu_choice (menu_choice
);
989 /* This callback is called from the menu bar pulldown menu
990 when the user makes a selection.
991 Figure out what the user chose
992 and put the appropriate events into the keyboard buffer. */
995 menubar_selection_callback (FRAME_PTR f
, int client_data
)
997 Lisp_Object prefix
, entry
;
999 Lisp_Object
*subprefix_stack
;
1000 int submenu_depth
= 0;
1006 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1007 vector
= f
->menu_bar_vector
;
1010 while (i
< f
->menu_bar_items_used
)
1012 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1014 subprefix_stack
[submenu_depth
++] = prefix
;
1018 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1020 prefix
= subprefix_stack
[--submenu_depth
];
1023 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1025 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1026 i
+= MENU_ITEMS_PANE_LENGTH
;
1030 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1031 /* The EMACS_INT cast avoids a warning. There's no problem
1032 as long as pointers have enough bits to hold small integers. */
1033 if ((int) (EMACS_INT
) client_data
== i
)
1036 struct input_event buf
;
1040 XSETFRAME (frame
, f
);
1041 buf
.kind
= MENU_BAR_EVENT
;
1042 buf
.frame_or_window
= frame
;
1044 kbd_buffer_store_event (&buf
);
1046 for (j
= 0; j
< submenu_depth
; j
++)
1047 if (!NILP (subprefix_stack
[j
]))
1049 buf
.kind
= MENU_BAR_EVENT
;
1050 buf
.frame_or_window
= frame
;
1051 buf
.arg
= subprefix_stack
[j
];
1052 kbd_buffer_store_event (&buf
);
1057 buf
.kind
= MENU_BAR_EVENT
;
1058 buf
.frame_or_window
= frame
;
1060 kbd_buffer_store_event (&buf
);
1063 buf
.kind
= MENU_BAR_EVENT
;
1064 buf
.frame_or_window
= frame
;
1066 kbd_buffer_store_event (&buf
);
1068 f
->output_data
.mac
->menu_command_in_progress
= 0;
1069 f
->output_data
.mac
->menubar_active
= 0;
1072 i
+= MENU_ITEMS_ITEM_LENGTH
;
1075 f
->output_data
.mac
->menu_command_in_progress
= 0;
1076 f
->output_data
.mac
->menubar_active
= 0;
1079 /* Allocate a widget_value, blocking input. */
1082 xmalloc_widget_value ()
1084 widget_value
*value
;
1087 value
= malloc_widget_value ();
1093 /* This recursively calls free_widget_value on the tree of widgets.
1094 It must free all data that was malloc'ed for these widget_values.
1095 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1096 must be left alone. */
1099 free_menubar_widget_value_tree (wv
)
1104 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1106 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1108 free_menubar_widget_value_tree (wv
->contents
);
1109 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1113 free_menubar_widget_value_tree (wv
->next
);
1114 wv
->next
= (widget_value
*) 0xDEADBEEF;
1117 free_widget_value (wv
);
1121 /* Return a tree of widget_value structures for a menu bar item
1122 whose event type is ITEM_KEY (with string ITEM_NAME)
1123 and whose contents come from the list of keymaps MAPS. */
1125 static widget_value
*
1126 single_submenu (item_key
, item_name
, maps
)
1127 Lisp_Object item_key
, item_name
, maps
;
1129 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1131 int submenu_depth
= 0;
1134 Lisp_Object
*mapvec
;
1135 widget_value
**submenu_stack
;
1136 int previous_items
= menu_items_used
;
1137 int top_level_items
= 0;
1139 length
= Flength (maps
);
1140 len
= XINT (length
);
1142 /* Convert the list MAPS into a vector MAPVEC. */
1143 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1144 for (i
= 0; i
< len
; i
++)
1146 mapvec
[i
] = Fcar (maps
);
1150 menu_items_n_panes
= 0;
1152 /* Loop over the given keymaps, making a pane for each map.
1153 But don't make a pane that is empty--ignore that map instead. */
1154 for (i
= 0; i
< len
; i
++)
1156 if (SYMBOLP (mapvec
[i
])
1157 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1159 /* Here we have a command at top level in the menu bar
1160 as opposed to a submenu. */
1161 top_level_items
= 1;
1162 push_menu_pane (Qnil
, Qnil
);
1163 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1164 Qnil
, Qnil
, Qnil
, Qnil
);
1167 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1170 /* Create a tree of widget_value objects
1171 representing the panes and their items. */
1174 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1175 wv
= xmalloc_widget_value ();
1179 wv
->button_type
= BUTTON_TYPE_NONE
;
1185 /* Loop over all panes and items made during this call
1186 and construct a tree of widget_value objects.
1187 Ignore the panes and items made by previous calls to
1188 single_submenu, even though those are also in menu_items. */
1190 while (i
< menu_items_used
)
1192 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1194 submenu_stack
[submenu_depth
++] = save_wv
;
1199 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1202 save_wv
= submenu_stack
[--submenu_depth
];
1205 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1206 && submenu_depth
!= 0)
1207 i
+= MENU_ITEMS_PANE_LENGTH
;
1208 /* Ignore a nil in the item list.
1209 It's meaningful only for dialog boxes. */
1210 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1212 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1214 /* Create a new pane. */
1215 Lisp_Object pane_name
, prefix
;
1218 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1219 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1221 #ifndef HAVE_MULTILINGUAL_MENU
1222 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1224 pane_name
= ENCODE_SYSTEM (pane_name
);
1225 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1228 pane_string
= (NILP (pane_name
)
1229 ? "" : (char *) SDATA (pane_name
));
1230 /* If there is just one top-level pane, put all its items directly
1231 under the top-level menu. */
1232 if (menu_items_n_panes
== 1)
1235 /* If the pane has a meaningful name,
1236 make the pane a top-level menu item
1237 with its items as a submenu beneath it. */
1238 if (strcmp (pane_string
, ""))
1240 wv
= xmalloc_widget_value ();
1244 first_wv
->contents
= wv
;
1245 wv
->name
= pane_string
;
1246 /* Ignore the @ that means "separate pane".
1247 This is a kludge, but this isn't worth more time. */
1248 if (!NILP (prefix
) && wv
->name
[0] == '@')
1252 wv
->button_type
= BUTTON_TYPE_NONE
;
1257 i
+= MENU_ITEMS_PANE_LENGTH
;
1261 /* Create a new item within current pane. */
1262 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1265 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1266 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1267 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1268 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1269 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1270 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1271 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1273 #ifndef HAVE_MULTILINGUAL_MENU
1274 if (STRING_MULTIBYTE (item_name
))
1276 item_name
= ENCODE_SYSTEM (item_name
);
1277 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1280 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1282 descrip
= ENCODE_SYSTEM (descrip
);
1283 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1285 #endif /* not HAVE_MULTILINGUAL_MENU */
1287 wv
= xmalloc_widget_value ();
1291 save_wv
->contents
= wv
;
1293 wv
->name
= (char *) SDATA (item_name
);
1294 if (!NILP (descrip
))
1295 wv
->key
= (char *) SDATA (descrip
);
1297 /* The EMACS_INT cast avoids a warning. There's no problem
1298 as long as pointers have enough bits to hold small integers. */
1299 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1300 wv
->enabled
= !NILP (enable
);
1303 wv
->button_type
= BUTTON_TYPE_NONE
;
1304 else if (EQ (type
, QCradio
))
1305 wv
->button_type
= BUTTON_TYPE_RADIO
;
1306 else if (EQ (type
, QCtoggle
))
1307 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1311 wv
->selected
= !NILP (selected
);
1312 if (!STRINGP (help
))
1319 i
+= MENU_ITEMS_ITEM_LENGTH
;
1323 /* If we have just one "menu item"
1324 that was originally a button, return it by itself. */
1325 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1327 wv
= first_wv
->contents
;
1328 free_widget_value (first_wv
);
1335 /* Set the contents of the menubar widgets of frame F.
1336 The argument FIRST_TIME is currently ignored;
1337 it is set the first time this is called, from initialize_frame_menubar. */
1340 set_frame_menubar (f
, first_time
, deep_p
)
1345 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1347 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1350 /* We must not change the menubar when actually in use. */
1351 if (f
->output_data
.mac
->menubar_active
)
1354 XSETFRAME (Vmenu_updating_frame
, f
);
1356 if (! menubar_widget
)
1358 else if (pending_menu_activation
&& !deep_p
)
1361 wv
= xmalloc_widget_value ();
1362 wv
->name
= "menubar";
1365 wv
->button_type
= BUTTON_TYPE_NONE
;
1371 /* Make a widget-value tree representing the entire menu trees. */
1373 struct buffer
*prev
= current_buffer
;
1375 int specpdl_count
= SPECPDL_INDEX ();
1376 int previous_menu_items_used
= f
->menu_bar_items_used
;
1377 Lisp_Object
*previous_items
1378 = (Lisp_Object
*) alloca (previous_menu_items_used
1379 * sizeof (Lisp_Object
));
1381 /* If we are making a new widget, its contents are empty,
1382 do always reinitialize them. */
1383 if (! menubar_widget
)
1384 previous_menu_items_used
= 0;
1386 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1387 specbind (Qinhibit_quit
, Qt
);
1388 /* Don't let the debugger step into this code
1389 because it is not reentrant. */
1390 specbind (Qdebug_on_next_call
, Qnil
);
1392 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1393 if (NILP (Voverriding_local_map_menu_flag
))
1395 specbind (Qoverriding_terminal_local_map
, Qnil
);
1396 specbind (Qoverriding_local_map
, Qnil
);
1399 set_buffer_internal_1 (XBUFFER (buffer
));
1401 /* Run the Lucid hook. */
1402 safe_run_hooks (Qactivate_menubar_hook
);
1403 /* If it has changed current-menubar from previous value,
1404 really recompute the menubar from the value. */
1405 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1406 call0 (Qrecompute_lucid_menubar
);
1407 safe_run_hooks (Qmenu_bar_update_hook
);
1408 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1410 items
= FRAME_MENU_BAR_ITEMS (f
);
1412 inhibit_garbage_collection ();
1414 /* Save the frame's previous menu bar contents data. */
1415 if (previous_menu_items_used
)
1416 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1417 previous_menu_items_used
* sizeof (Lisp_Object
));
1419 /* Fill in the current menu bar contents. */
1420 menu_items
= f
->menu_bar_vector
;
1421 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1423 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1425 Lisp_Object key
, string
, maps
;
1427 key
= XVECTOR (items
)->contents
[i
];
1428 string
= XVECTOR (items
)->contents
[i
+ 1];
1429 maps
= XVECTOR (items
)->contents
[i
+ 2];
1433 wv
= single_submenu (key
, string
, maps
);
1437 first_wv
->contents
= wv
;
1438 /* Don't set wv->name here; GC during the loop might relocate it. */
1440 wv
->button_type
= BUTTON_TYPE_NONE
;
1444 finish_menu_items ();
1446 set_buffer_internal_1 (prev
);
1447 unbind_to (specpdl_count
, Qnil
);
1449 /* If there has been no change in the Lisp-level contents
1450 of the menu bar, skip redisplaying it. Just exit. */
1452 for (i
= 0; i
< previous_menu_items_used
; i
++)
1453 if (menu_items_used
== i
1454 || (!Fequal (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1456 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1458 free_menubar_widget_value_tree (first_wv
);
1464 /* Now GC cannot happen during the lifetime of the widget_value,
1465 so it's safe to store data from a Lisp_String, as long as
1466 local copies are made when the actual menu is created.
1467 Windows takes care of this for normal string items, but
1468 not for owner-drawn items or additional item-info. */
1469 wv
= first_wv
->contents
;
1470 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1473 string
= XVECTOR (items
)->contents
[i
+ 1];
1476 wv
->name
= (char *) SDATA (string
);
1480 f
->menu_bar_vector
= menu_items
;
1481 f
->menu_bar_items_used
= menu_items_used
;
1486 /* Make a widget-value tree containing
1487 just the top level menu bar strings. */
1489 items
= FRAME_MENU_BAR_ITEMS (f
);
1490 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1494 string
= XVECTOR (items
)->contents
[i
+ 1];
1498 wv
= xmalloc_widget_value ();
1499 wv
->name
= (char *) SDATA (string
);
1502 wv
->button_type
= BUTTON_TYPE_NONE
;
1504 /* This prevents lwlib from assuming this
1505 menu item is really supposed to be empty. */
1506 /* The EMACS_INT cast avoids a warning.
1507 This value just has to be different from small integers. */
1508 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1513 first_wv
->contents
= wv
;
1517 /* Forget what we thought we knew about what is in the
1518 detailed contents of the menu bar menus.
1519 Changing the top level always destroys the contents. */
1520 f
->menu_bar_items_used
= 0;
1523 /* Create or update the menu bar widget. */
1527 /* Non-null value to indicate menubar has already been "created". */
1528 f
->output_data
.mac
->menubar_widget
= 1;
1531 int i
= MIN_MENU_ID
;
1532 MenuHandle menu
= GetMenuHandle (i
);
1533 while (menu
!= NULL
)
1537 menu
= GetMenuHandle (++i
);
1541 menu
= GetMenuHandle (i
);
1542 while (menu
!= NULL
)
1546 menu
= GetMenuHandle (++i
);
1550 fill_menubar (first_wv
->contents
);
1554 free_menubar_widget_value_tree (first_wv
);
1559 /* Called from Fx_create_frame to create the initial menubar of a frame
1560 before it is mapped, so that the window is mapped with the menubar already
1561 there instead of us tacking it on later and thrashing the window after it
1565 initialize_frame_menubar (f
)
1568 /* This function is called before the first chance to redisplay
1569 the frame. It has to be, so the frame will have the right size. */
1570 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1571 set_frame_menubar (f
, 1, 1);
1574 /* Get rid of the menu bar of frame F, and free its storage.
1575 This is used when deleting a frame, and when turning off the menu bar. */
1578 free_frame_menubar (f
)
1581 f
->output_data
.mac
->menubar_widget
= NULL
;
1585 /* mac_menu_show actually displays a menu using the panes and items in
1586 menu_items and returns the value selected from it; we assume input
1587 is blocked by the caller. */
1589 /* F is the frame the menu is for.
1590 X and Y are the frame-relative specified position,
1591 relative to the inside upper left corner of the frame F.
1592 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1593 KEYMAPS is 1 if this menu was specified with keymaps;
1594 in that case, we return a list containing the chosen item's value
1595 and perhaps also the pane's prefix.
1596 TITLE is the specified menu title.
1597 ERROR is a place to store an error message string in case of failure.
1598 (We return nil on failure, but the value doesn't actually matter.) */
1601 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1612 int menu_item_choice
;
1613 int menu_item_selection
;
1616 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1617 widget_value
**submenu_stack
1618 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1619 Lisp_Object
*subprefix_stack
1620 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1621 int submenu_depth
= 0;
1626 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1628 *error
= "Empty menu";
1632 /* Create a tree of widget_value objects
1633 representing the panes and their items. */
1634 wv
= xmalloc_widget_value ();
1638 wv
->button_type
= BUTTON_TYPE_NONE
;
1643 /* Loop over all panes and items, filling in the tree. */
1645 while (i
< menu_items_used
)
1647 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1649 submenu_stack
[submenu_depth
++] = save_wv
;
1655 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1658 save_wv
= submenu_stack
[--submenu_depth
];
1662 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1663 && submenu_depth
!= 0)
1664 i
+= MENU_ITEMS_PANE_LENGTH
;
1665 /* Ignore a nil in the item list.
1666 It's meaningful only for dialog boxes. */
1667 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1669 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1671 /* Create a new pane. */
1672 Lisp_Object pane_name
, prefix
;
1674 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1675 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1676 #ifndef HAVE_MULTILINGUAL_MENU
1677 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1679 pane_name
= ENCODE_SYSTEM (pane_name
);
1680 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1683 pane_string
= (NILP (pane_name
)
1684 ? "" : (char *) SDATA (pane_name
));
1685 /* If there is just one top-level pane, put all its items directly
1686 under the top-level menu. */
1687 if (menu_items_n_panes
== 1)
1690 /* If the pane has a meaningful name,
1691 make the pane a top-level menu item
1692 with its items as a submenu beneath it. */
1693 if (!keymaps
&& strcmp (pane_string
, ""))
1695 wv
= xmalloc_widget_value ();
1699 first_wv
->contents
= wv
;
1700 wv
->name
= pane_string
;
1701 if (keymaps
&& !NILP (prefix
))
1705 wv
->button_type
= BUTTON_TYPE_NONE
;
1710 else if (first_pane
)
1716 i
+= MENU_ITEMS_PANE_LENGTH
;
1720 /* Create a new item within current pane. */
1721 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1723 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1724 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1725 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1726 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1727 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1728 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1729 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1731 #ifndef HAVE_MULTILINGUAL_MENU
1732 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1734 item_name
= ENCODE_SYSTEM (item_name
);
1735 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1737 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1739 descrip
= ENCODE_SYSTEM (descrip
);
1740 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1742 #endif /* not HAVE_MULTILINGUAL_MENU */
1744 wv
= xmalloc_widget_value ();
1748 save_wv
->contents
= wv
;
1749 wv
->name
= (char *) SDATA (item_name
);
1750 if (!NILP (descrip
))
1751 wv
->key
= (char *) SDATA (descrip
);
1753 /* Use the contents index as call_data, since we are
1754 restricted to 16-bits. */
1755 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1756 wv
->enabled
= !NILP (enable
);
1759 wv
->button_type
= BUTTON_TYPE_NONE
;
1760 else if (EQ (type
, QCtoggle
))
1761 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1762 else if (EQ (type
, QCradio
))
1763 wv
->button_type
= BUTTON_TYPE_RADIO
;
1767 wv
->selected
= !NILP (selected
);
1768 if (!STRINGP (help
))
1775 i
+= MENU_ITEMS_ITEM_LENGTH
;
1779 /* Deal with the title, if it is non-nil. */
1782 widget_value
*wv_title
= xmalloc_widget_value ();
1783 widget_value
*wv_sep
= xmalloc_widget_value ();
1785 /* Maybe replace this separator with a bitmap or owner-draw item
1786 so that it looks better. Having two separators looks odd. */
1787 wv_sep
->name
= "--";
1788 wv_sep
->next
= first_wv
->contents
;
1789 wv_sep
->help
= Qnil
;
1791 #ifndef HAVE_MULTILINGUAL_MENU
1792 if (STRING_MULTIBYTE (title
))
1793 title
= ENCODE_SYSTEM (title
);
1795 wv_title
->name
= (char *) SDATA (title
);
1796 wv_title
->enabled
= TRUE
;
1797 wv_title
->title
= TRUE
;
1798 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1799 wv_title
->help
= Qnil
;
1800 wv_title
->next
= wv_sep
;
1801 first_wv
->contents
= wv_title
;
1804 /* Actually create the menu. */
1805 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1806 submenu_id
= MIN_POPUP_SUBMENU_ID
;
1807 fill_submenu (menu
, first_wv
->contents
);
1809 /* Adjust coordinates to be root-window-relative. */
1813 #if TARGET_API_MAC_CARBON
1814 SetPort (GetWindowPort (FRAME_MAC_WINDOW (f
)));
1816 SetPort (FRAME_MAC_WINDOW (f
));
1819 LocalToGlobal (&pos
);
1821 /* No selection has been chosen yet. */
1822 menu_item_choice
= 0;
1823 menu_item_selection
= 0;
1825 InsertMenu (menu
, -1);
1827 /* Display the menu. */
1828 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
1829 menu_item_selection
= LoWord (menu_item_choice
);
1831 /* Get the refcon to find the correct item*/
1832 if (menu_item_selection
)
1834 menu
= GetMenuHandle (HiWord (menu_item_choice
));
1836 GetMenuItemRefCon (menu
, menu_item_selection
, &refcon
);
1841 /* Clean up extraneous mouse events which might have been generated
1843 discard_mouse_events ();
1846 /* Free the widget_value objects we used to specify the
1848 free_menubar_widget_value_tree (first_wv
);
1850 /* delete all menus */
1852 int i
= MIN_POPUP_SUBMENU_ID
;
1853 MenuHandle submenu
= GetMenuHandle (i
);
1854 while (menu
!= NULL
)
1858 menu
= GetMenuHandle (++i
);
1862 DeleteMenu (POPUP_SUBMENU_ID
);
1865 /* Find the selected item, and its pane, to return
1866 the proper value. */
1867 if (menu_item_selection
!= 0)
1869 Lisp_Object prefix
, entry
;
1871 prefix
= entry
= Qnil
;
1873 while (i
< menu_items_used
)
1875 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1877 subprefix_stack
[submenu_depth
++] = prefix
;
1881 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1883 prefix
= subprefix_stack
[--submenu_depth
];
1886 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1889 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1890 i
+= MENU_ITEMS_PANE_LENGTH
;
1892 /* Ignore a nil in the item list.
1893 It's meaningful only for dialog boxes. */
1894 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1899 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1900 if ((int) (EMACS_INT
) refcon
== i
)
1906 entry
= Fcons (entry
, Qnil
);
1908 entry
= Fcons (prefix
, entry
);
1909 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1910 if (!NILP (subprefix_stack
[j
]))
1911 entry
= Fcons (subprefix_stack
[j
], entry
);
1915 i
+= MENU_ITEMS_ITEM_LENGTH
;
1925 /* Construct native Mac OS menubar based on widget_value tree. */
1928 mac_dialog (widget_value
*wv
)
1932 char **button_labels
;
1939 WindowPtr window_ptr
;
1942 EventRecord event_record
;
1944 int control_part_code
;
1947 dialog_name
= wv
->name
;
1948 nb_buttons
= dialog_name
[1] - '0';
1949 left_count
= nb_buttons
- (dialog_name
[4] - '0');
1950 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
1951 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
1954 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
1955 strcpy (prompt
, wv
->value
);
1959 for (i
= 0; i
< nb_buttons
; i
++)
1961 button_labels
[i
] = wv
->value
;
1962 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
1963 strcpy (button_labels
[i
], wv
->value
);
1964 c2pstr (button_labels
[i
]);
1965 ref_cons
[i
] = (UInt32
) wv
->call_data
;
1969 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
1971 #if TARGET_API_MAC_CARBON
1972 SetPort (GetWindowPort (window_ptr
));
1974 SetPort (window_ptr
);
1978 /* Left and right margins in the dialog are 13 pixels each.*/
1980 /* Calculate width of dialog box: 8 pixels on each side of the text
1981 label in each button, 12 pixels between buttons. */
1982 for (i
= 0; i
< nb_buttons
; i
++)
1983 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1985 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1988 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
1990 SizeWindow (window_ptr
, dialog_width
, 78, 0);
1991 ShowWindow (window_ptr
);
1993 #if TARGET_API_MAC_CARBON
1994 SetPort (GetWindowPort (window_ptr
));
1996 SetPort (window_ptr
);
2002 DrawString (prompt
);
2005 for (i
= 0; i
< nb_buttons
; i
++)
2007 int button_width
= StringWidth (button_labels
[i
]) + 16;
2008 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
2009 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
2010 kControlPushButtonProc
, ref_cons
[i
]);
2011 left
+= button_width
+ 12;
2012 if (i
== left_count
- 1)
2019 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
2020 if (event_record
.what
== mouseDown
)
2022 part_code
= FindWindow (event_record
.where
, &window_ptr
);
2023 if (part_code
== inContent
)
2025 mouse
= event_record
.where
;
2026 GlobalToLocal (&mouse
);
2027 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2028 if (control_part_code
== kControlButtonPart
)
2029 if (TrackControl (ch
, mouse
, NULL
))
2030 i
= GetControlReference (ch
);
2035 DisposeWindow (window_ptr
);
2040 static char * button_names
[] = {
2041 "button1", "button2", "button3", "button4", "button5",
2042 "button6", "button7", "button8", "button9", "button10" };
2045 mac_dialog_show (f
, keymaps
, title
, error
)
2051 int i
, nb_buttons
=0;
2052 char dialog_name
[6];
2053 int menu_item_selection
;
2055 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2057 /* Number of elements seen so far, before boundary. */
2059 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2060 int boundary_seen
= 0;
2064 if (menu_items_n_panes
> 1)
2066 *error
= "Multiple panes in dialog box";
2070 /* Create a tree of widget_value objects
2071 representing the text label and buttons. */
2073 Lisp_Object pane_name
, prefix
;
2075 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2076 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2077 pane_string
= (NILP (pane_name
)
2078 ? "" : (char *) SDATA (pane_name
));
2079 prev_wv
= xmalloc_widget_value ();
2080 prev_wv
->value
= pane_string
;
2081 if (keymaps
&& !NILP (prefix
))
2083 prev_wv
->enabled
= 1;
2084 prev_wv
->name
= "message";
2085 prev_wv
->help
= Qnil
;
2088 /* Loop over all panes and items, filling in the tree. */
2089 i
= MENU_ITEMS_PANE_LENGTH
;
2090 while (i
< menu_items_used
)
2093 /* Create a new item within current pane. */
2094 Lisp_Object item_name
, enable
, descrip
, help
;
2096 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2097 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2099 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2100 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2102 if (NILP (item_name
))
2104 free_menubar_widget_value_tree (first_wv
);
2105 *error
= "Submenu in dialog items";
2108 if (EQ (item_name
, Qquote
))
2110 /* This is the boundary between left-side elts
2111 and right-side elts. Stop incrementing right_count. */
2116 if (nb_buttons
>= 9)
2118 free_menubar_widget_value_tree (first_wv
);
2119 *error
= "Too many dialog items";
2123 wv
= xmalloc_widget_value ();
2125 wv
->name
= (char *) button_names
[nb_buttons
];
2126 if (!NILP (descrip
))
2127 wv
->key
= (char *) SDATA (descrip
);
2128 wv
->value
= (char *) SDATA (item_name
);
2129 wv
->call_data
= (void *) i
;
2130 /* menu item is identified by its index in menu_items table */
2131 wv
->enabled
= !NILP (enable
);
2135 if (! boundary_seen
)
2139 i
+= MENU_ITEMS_ITEM_LENGTH
;
2142 /* If the boundary was not specified,
2143 by default put half on the left and half on the right. */
2144 if (! boundary_seen
)
2145 left_count
= nb_buttons
- nb_buttons
/ 2;
2147 wv
= xmalloc_widget_value ();
2148 wv
->name
= dialog_name
;
2151 /* Dialog boxes use a really stupid name encoding
2152 which specifies how many buttons to use
2153 and how many buttons are on the right.
2154 The Q means something also. */
2155 dialog_name
[0] = 'Q';
2156 dialog_name
[1] = '0' + nb_buttons
;
2157 dialog_name
[2] = 'B';
2158 dialog_name
[3] = 'R';
2159 /* Number of buttons to put on the right. */
2160 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2162 wv
->contents
= first_wv
;
2166 /* Actually create the dialog. */
2168 menu_item_selection
= mac_dialog (first_wv
);
2170 menu_item_selection
= 0;
2173 /* Free the widget_value objects we used to specify the contents. */
2174 free_menubar_widget_value_tree (first_wv
);
2176 /* Find the selected item, and its pane, to return the proper
2178 if (menu_item_selection
!= 0)
2184 while (i
< menu_items_used
)
2188 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2191 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2192 i
+= MENU_ITEMS_PANE_LENGTH
;
2197 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2198 if (menu_item_selection
== i
)
2202 entry
= Fcons (entry
, Qnil
);
2204 entry
= Fcons (prefix
, entry
);
2208 i
+= MENU_ITEMS_ITEM_LENGTH
;
2215 #endif /* HAVE_DIALOGS */
2218 /* Is this item a separator? */
2220 name_is_separator (name
)
2225 /* Check if name string consists of only dashes ('-'). */
2226 while (*name
== '-') name
++;
2227 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2228 or "--deep-shadow". We don't implement them yet, se we just treat
2229 them like normal separators. */
2230 return (*name
== '\0' || start
+ 2 == name
);
2234 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
,
2240 if (name_is_separator (wv
->name
))
2241 AppendMenu (menu
, "\p-");
2244 AppendMenu (menu
, "\pX");
2246 #if TARGET_API_MAC_CARBON
2247 pos
= CountMenuItems (menu
);
2249 pos
= CountMItems (menu
);
2252 strcpy (item_name
, "");
2253 strncat (item_name
, wv
->name
, 255);
2254 if (wv
->key
!= NULL
)
2256 strncat (item_name
, " ", 255);
2257 strncat (item_name
, wv
->key
, 255);
2261 SetMenuItemText (menu
, pos
, item_name
);
2263 if (wv
->enabled
&& !force_disable
)
2264 #if TARGET_API_MAC_CARBON
2265 EnableMenuItem (menu
, pos
);
2267 EnableItem (menu
, pos
);
2270 #if TARGET_API_MAC_CARBON
2271 DisableMenuItem (menu
, pos
);
2273 DisableItem (menu
, pos
);
2276 /* Draw radio buttons and tickboxes. */
2278 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2279 wv
->button_type
== BUTTON_TYPE_RADIO
))
2280 SetItemMark (menu
, pos
, checkMark
);
2282 SetItemMark (menu
, pos
, noMark
);
2286 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2288 if (submenu
!= NULL
)
2289 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2292 /* Construct native Mac OS menubar based on widget_value tree. */
2295 fill_submenu (MenuHandle menu
, widget_value
*wv
)
2297 for ( ; wv
!= NULL
; wv
= wv
->next
)
2300 int cur_submenu
= submenu_id
++;
2301 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2302 fill_submenu (submenu
, wv
->contents
);
2303 InsertMenu (submenu
, -1);
2304 add_menu_item (menu
, wv
, cur_submenu
, 0);
2307 add_menu_item (menu
, wv
, NULL
, 0);
2311 /* Construct native Mac OS menu based on widget_value tree. */
2314 fill_menu (MenuHandle menu
, widget_value
*wv
)
2316 for ( ; wv
!= NULL
; wv
= wv
->next
)
2319 int cur_submenu
= submenu_id
++;
2320 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2321 fill_submenu (submenu
, wv
->contents
);
2322 InsertMenu (submenu
, -1);
2323 add_menu_item (menu
, wv
, cur_submenu
, 0);
2326 add_menu_item (menu
, wv
, NULL
, 0);
2329 /* Construct native Mac OS menubar based on widget_value tree. */
2332 fill_menubar (widget_value
*wv
)
2336 submenu_id
= MIN_SUBMENU_ID
;
2338 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2343 strncpy (title
, wv
->name
, 255);
2346 menu
= NewMenu (id
, title
);
2349 fill_menu (menu
, wv
->contents
);
2351 InsertMenu (menu
, 0);
2355 #endif /* HAVE_MENUS */
2361 staticpro (&menu_items
);
2364 Qdebug_on_next_call
= intern ("debug-on-next-call");
2365 staticpro (&Qdebug_on_next_call
);
2367 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2368 doc
: /* Frame for which we are updating a menu.
2369 The enable predicate for a menu command should check this variable. */);
2370 Vmenu_updating_frame
= Qnil
;
2372 defsubr (&Sx_popup_menu
);
2374 defsubr (&Sx_popup_dialog
);