1 /* Menu support for GNU Emacs on the for Mac OS.
2 Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Contributed by Andrew Choi (akochoi@mac.com). */
28 #include "termhooks.h"
33 #include "blockinput.h"
45 /* Macros max and min defined in lisp.h conflict with those in
46 precompiled header Carbon.h. */
50 #include <Carbon/Carbon.h>
52 #define Z (current_buffer->text->z)
54 #define free unexec_free
56 #define malloc unexec_malloc
58 #define realloc unexec_realloc
60 #define min(a, b) ((a) < (b) ? (a) : (b))
62 #define max(a, b) ((a) > (b) ? (a) : (b))
64 #define init_process emacs_init_process
65 #else /* not MAC_OSX */
68 #include <QuickDraw.h>
69 #include <ToolUtils.h>
74 #if defined (__MRC__) || (__MSL__ >= 0x6000)
75 #include <ControlDefinitions.h>
77 #endif /* not MAC_OSX */
79 /* This may include sys/types.h, and that somehow loses
80 if this is not done before the other system files. */
83 /* Load sys/types.h if not already loaded.
84 In some systems loading it twice is suicidal. */
86 #include <sys/types.h>
89 #include "dispextern.h"
91 #define POPUP_SUBMENU_ID 235
92 #define MIN_POPUP_SUBMENU_ID 512
93 #define MIN_MENU_ID 256
94 #define MIN_SUBMENU_ID 1
96 #define DIALOG_WINDOW_RESOURCE 130
98 #define HAVE_DIALOGS 1
100 #undef HAVE_MULTILINGUAL_MENU
101 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
103 /******************************************************************/
104 /* Definitions copied from lwlib.h */
106 typedef void * XtPointer
;
115 /* This structure is based on the one in ../lwlib/lwlib.h, modified
117 typedef struct _widget_value
121 /* value (meaning depend on widget type) */
123 /* keyboard equivalent. no implications for XtTranslations */
125 /* Help string or nil if none.
126 GC finds this string through the frame's menu_bar_vector
127 or through menu_items. */
129 /* true if enabled */
131 /* true if selected */
133 /* The type of a button. */
134 enum button_type button_type
;
135 /* true if menu title */
138 /* true if was edited (maintained by get_value) */
140 /* true if has changed (maintained by lw library) */
142 /* true if this widget itself has changed,
143 but not counting the other widgets found in the `next' field. */
144 change_type this_one_change
;
146 /* Contents of the sub-widgets, also selected slot for checkbox */
147 struct _widget_value
* contents
;
148 /* data passed to callback */
150 /* next one in the list */
151 struct _widget_value
* next
;
153 /* slot for the toolkit dependent part. Always initialize to NULL. */
155 /* tell us if we should free the toolkit data slot when freeing the
156 widget_value itself. */
157 Boolean free_toolkit_data
;
159 /* we resource the widget_value structures; this points to the next
160 one on the free list if this one has been deallocated.
162 struct _widget_value
*free_list
;
166 /* Assumed by other routines to zero area returned. */
167 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
168 0, (sizeof (widget_value)))
169 #define free_widget_value(wv) xfree (wv)
171 /******************************************************************/
178 Lisp_Object Vmenu_updating_frame
;
180 Lisp_Object Qdebug_on_next_call
;
182 extern Lisp_Object Qmenu_bar
;
184 extern Lisp_Object QCtoggle
, QCradio
;
186 extern Lisp_Object Voverriding_local_map
;
187 extern Lisp_Object Voverriding_local_map_menu_flag
;
189 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
191 extern Lisp_Object Qmenu_bar_update_hook
;
193 void set_frame_menubar ();
195 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
196 Lisp_Object
, Lisp_Object
, Lisp_Object
,
197 Lisp_Object
, Lisp_Object
));
199 static Lisp_Object
mac_dialog_show ();
201 static Lisp_Object
mac_menu_show ();
203 static void keymap_panes ();
204 static void single_keymap_panes ();
205 static void single_menu_item ();
206 static void list_of_panes ();
207 static void list_of_items ();
209 static void fill_submenu (MenuHandle
, widget_value
*);
210 static void fill_menubar (widget_value
*);
213 /* This holds a Lisp vector that holds the results of decoding
214 the keymaps or alist-of-alists that specify a menu.
216 It describes the panes and items within the panes.
218 Each pane is described by 3 elements in the vector:
219 t, the pane name, the pane's prefix key.
220 Then follow the pane's items, with 5 elements per item:
221 the item string, the enable flag, the item's value,
222 the definition, and the equivalent keyboard key's description string.
224 In some cases, multiple levels of menus may be described.
225 A single vector slot containing nil indicates the start of a submenu.
226 A single vector slot containing lambda indicates the end of a submenu.
227 The submenu follows a menu item which is the way to reach the submenu.
229 A single vector slot containing quote indicates that the
230 following items should appear on the right of a dialog box.
232 Using a Lisp vector to hold this information while we decode it
233 takes care of protecting all the data from GC. */
235 #define MENU_ITEMS_PANE_NAME 1
236 #define MENU_ITEMS_PANE_PREFIX 2
237 #define MENU_ITEMS_PANE_LENGTH 3
241 MENU_ITEMS_ITEM_NAME
= 0,
242 MENU_ITEMS_ITEM_ENABLE
,
243 MENU_ITEMS_ITEM_VALUE
,
244 MENU_ITEMS_ITEM_EQUIV_KEY
,
245 MENU_ITEMS_ITEM_DEFINITION
,
246 MENU_ITEMS_ITEM_TYPE
,
247 MENU_ITEMS_ITEM_SELECTED
,
248 MENU_ITEMS_ITEM_HELP
,
249 MENU_ITEMS_ITEM_LENGTH
252 static Lisp_Object menu_items
;
254 /* Number of slots currently allocated in menu_items. */
255 static int menu_items_allocated
;
257 /* This is the index in menu_items of the first empty slot. */
258 static int menu_items_used
;
260 /* The number of panes currently recorded in menu_items,
261 excluding those within submenus. */
262 static int menu_items_n_panes
;
264 /* Current depth within submenus. */
265 static int menu_items_submenu_depth
;
267 /* Flag which when set indicates a dialog or menu has been posted by
268 Xt on behalf of one of the widget sets. */
269 static int popup_activated_flag
;
271 /* Index of the next submenu */
272 static int submenu_id
;
274 static int next_menubar_widget_id
;
276 /* This is set nonzero after the user activates the menu bar, and set
277 to zero again after the menu bars are redisplayed by prepare_menu_bar.
278 While it is nonzero, all calls to set_frame_menubar go deep.
280 I don't understand why this is needed, but it does seem to be
281 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
283 int pending_menu_activation
;
285 /* Initialize the menu_items structure if we haven't already done so.
286 Also mark it as currently empty. */
291 if (NILP (menu_items
))
293 menu_items_allocated
= 60;
294 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
298 menu_items_n_panes
= 0;
299 menu_items_submenu_depth
= 0;
302 /* Call at the end of generating the data in menu_items.
303 This fills in the number of items in the last pane. */
310 /* Call when finished using the data for the current menu
314 discard_menu_items ()
316 /* Free the structure if it is especially large.
317 Otherwise, hold on to it, to save time. */
318 if (menu_items_allocated
> 200)
321 menu_items_allocated
= 0;
325 /* Make the menu_items vector twice as large. */
331 int old_size
= menu_items_allocated
;
334 menu_items_allocated
*= 2;
335 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
336 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
337 old_size
* sizeof (Lisp_Object
));
340 /* Begin a submenu. */
343 push_submenu_start ()
345 if (menu_items_used
+ 1 > menu_items_allocated
)
348 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
349 menu_items_submenu_depth
++;
357 if (menu_items_used
+ 1 > menu_items_allocated
)
360 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
361 menu_items_submenu_depth
--;
364 /* Indicate boundary between left and right. */
367 push_left_right_boundary ()
369 if (menu_items_used
+ 1 > menu_items_allocated
)
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
375 /* Start a new menu pane in menu_items.
376 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
379 push_menu_pane (name
, prefix_vec
)
380 Lisp_Object name
, prefix_vec
;
382 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
385 if (menu_items_submenu_depth
== 0)
386 menu_items_n_panes
++;
387 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
388 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
389 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
392 /* Push one menu item into the current pane. NAME is the string to
393 display. ENABLE if non-nil means this item can be selected. KEY
394 is the key generated by choosing this item, or nil if this item
395 doesn't really have a definition. DEF is the definition of this
396 item. EQUIV is the textual description of the keyboard equivalent
397 for this item (or nil if none). TYPE is the type of this menu
398 item, one of nil, `toggle' or `radio'. */
401 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
402 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
404 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
407 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
408 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
409 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
410 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
411 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
412 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
413 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
414 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
417 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
418 and generate menu panes for them in menu_items.
419 If NOTREAL is nonzero,
420 don't bother really computing whether an item is enabled. */
423 keymap_panes (keymaps
, nmaps
, notreal
)
424 Lisp_Object
*keymaps
;
432 /* Loop over the given keymaps, making a pane for each map.
433 But don't make a pane that is empty--ignore that map instead.
434 P is the number of panes we have made so far. */
435 for (mapno
= 0; mapno
< nmaps
; mapno
++)
436 single_keymap_panes (keymaps
[mapno
],
437 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
439 finish_menu_items ();
442 /* This is a recursive subroutine of keymap_panes.
443 It handles one keymap, KEYMAP.
444 The other arguments are passed along
445 or point to local variables of the previous function.
446 If NOTREAL is nonzero, only check for equivalent key bindings, don't
447 evaluate expressions in menu items and don't make any menu.
449 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
452 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
454 Lisp_Object pane_name
;
459 Lisp_Object pending_maps
= Qnil
;
460 Lisp_Object tail
, item
;
461 struct gcpro gcpro1
, gcpro2
;
466 push_menu_pane (pane_name
, prefix
);
468 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
470 GCPRO2 (keymap
, pending_maps
);
471 /* Look at each key binding, and if it is a menu item add it
475 single_menu_item (XCAR (item
), XCDR (item
),
476 &pending_maps
, notreal
, maxdepth
);
477 else if (VECTORP (item
))
479 /* Loop over the char values represented in the vector. */
480 int len
= XVECTOR (item
)->size
;
482 for (c
= 0; c
< len
; c
++)
484 Lisp_Object character
;
485 XSETFASTINT (character
, c
);
486 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
487 &pending_maps
, notreal
, maxdepth
);
493 /* Process now any submenus which want to be panes at this level. */
494 while (!NILP (pending_maps
))
496 Lisp_Object elt
, eltcdr
, string
;
497 elt
= Fcar (pending_maps
);
499 string
= XCAR (eltcdr
);
500 /* We no longer discard the @ from the beginning of the string here.
501 Instead, we do this in mac_menu_show. */
502 single_keymap_panes (Fcar (elt
), string
,
503 XCDR (eltcdr
), notreal
, maxdepth
- 1);
504 pending_maps
= Fcdr (pending_maps
);
508 /* This is a subroutine of single_keymap_panes that handles one
510 KEY is a key in a keymap and ITEM is its binding.
511 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
513 If NOTREAL is nonzero, only check for equivalent key bindings, don't
514 evaluate expressions in menu items and don't make any menu.
515 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
518 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
519 Lisp_Object key
, item
;
520 Lisp_Object
*pending_maps_ptr
;
521 int maxdepth
, notreal
;
523 Lisp_Object map
, item_string
, enabled
;
524 struct gcpro gcpro1
, gcpro2
;
527 /* Parse the menu item and leave the result in item_properties. */
529 res
= parse_menu_item (item
, notreal
, 0);
532 return; /* Not a menu item. */
534 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
538 /* We don't want to make a menu, just traverse the keymaps to
539 precompute equivalent key bindings. */
541 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
545 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
546 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
548 if (!NILP (map
) && SREF (item_string
, 0) == '@')
551 /* An enabled separate pane. Remember this to handle it later. */
552 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
557 push_menu_item (item_string
, enabled
, key
,
558 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
559 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
560 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
561 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
562 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
564 /* Display a submenu using the toolkit. */
565 if (! (NILP (map
) || NILP (enabled
)))
567 push_submenu_start ();
568 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
573 /* Push all the panes and items of a menu described by the
574 alist-of-alists MENU.
575 This handles old-fashioned calls to x-popup-menu. */
585 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
587 Lisp_Object elt
, pane_name
, pane_data
;
589 pane_name
= Fcar (elt
);
590 CHECK_STRING (pane_name
);
591 push_menu_pane (pane_name
, Qnil
);
592 pane_data
= Fcdr (elt
);
593 CHECK_CONS (pane_data
);
594 list_of_items (pane_data
);
597 finish_menu_items ();
600 /* Push the items in a single pane defined by the alist PANE. */
606 Lisp_Object tail
, item
, item1
;
608 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
612 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
613 else if (NILP (item
))
614 push_left_right_boundary ();
619 CHECK_STRING (item1
);
620 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
625 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
626 doc
: /* Pop up a deck-of-cards menu and return user's selection.
627 POSITION is a position specification. This is either a mouse button
628 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
629 are positions in pixels from the top left corner of WINDOW's frame
630 \(WINDOW may be a frame object instead of a window). This controls the
631 position of the center of the first line in the first pane of the
632 menu, not the top left of the menu as a whole. If POSITION is t, it
633 means to use the current mouse position.
635 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
636 The menu items come from key bindings that have a menu string as well as
637 a definition; actually, the \"definition\" in such a key binding looks like
638 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
639 the keymap as a top-level element.
641 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
642 Otherwise, REAL-DEFINITION should be a valid key binding definition.
644 You can also use a list of keymaps as MENU. Then each keymap makes a
645 separate pane. When MENU is a keymap or a list of keymaps, the return
646 value is a list of events.
648 Alternatively, you can specify a menu of multiple panes with a list of
649 the form (TITLE PANE1 PANE2...), where each pane is a list of
650 form (TITLE ITEM1 ITEM2...).
651 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
652 appear as an item--that makes a nonselectable line in the menu.
653 With this form of menu, the return value is VALUE from the chosen item.
655 If POSITION is nil, don't display the menu at all, just precalculate the
656 cached information about equivalent key sequences. */)
658 Lisp_Object position
, menu
;
660 Lisp_Object keymap
, tem
;
661 int xpos
= 0, ypos
= 0;
664 Lisp_Object selection
;
666 Lisp_Object x
, y
, window
;
672 if (! NILP (position
))
676 /* Decode the first argument: find the window and the coordinates. */
677 if (EQ (position
, Qt
)
678 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
679 || EQ (XCAR (position
), Qtool_bar
))))
681 /* Use the mouse's current position. */
682 FRAME_PTR new_f
= SELECTED_FRAME ();
683 Lisp_Object bar_window
;
684 enum scroll_bar_part part
;
687 if (mouse_position_hook
)
688 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
689 &part
, &x
, &y
, &time
);
691 XSETFRAME (window
, new_f
);
694 window
= selected_window
;
701 tem
= Fcar (position
);
704 window
= Fcar (Fcdr (position
));
706 y
= Fcar (Fcdr (tem
));
711 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
712 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
713 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
722 /* Decode where to put the menu. */
730 else if (WINDOWP (window
))
732 CHECK_LIVE_WINDOW (window
);
733 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
735 xpos
= 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
;
1039 XSETFRAME (frame
, f
);
1040 buf
.kind
= MENU_BAR_EVENT
;
1041 buf
.frame_or_window
= frame
;
1043 kbd_buffer_store_event (&buf
);
1045 for (j
= 0; j
< submenu_depth
; j
++)
1046 if (!NILP (subprefix_stack
[j
]))
1048 buf
.kind
= MENU_BAR_EVENT
;
1049 buf
.frame_or_window
= frame
;
1050 buf
.arg
= subprefix_stack
[j
];
1051 kbd_buffer_store_event (&buf
);
1056 buf
.kind
= MENU_BAR_EVENT
;
1057 buf
.frame_or_window
= frame
;
1059 kbd_buffer_store_event (&buf
);
1062 buf
.kind
= MENU_BAR_EVENT
;
1063 buf
.frame_or_window
= frame
;
1065 kbd_buffer_store_event (&buf
);
1067 f
->output_data
.mac
->menu_command_in_progress
= 0;
1068 f
->output_data
.mac
->menubar_active
= 0;
1071 i
+= MENU_ITEMS_ITEM_LENGTH
;
1074 f
->output_data
.mac
->menu_command_in_progress
= 0;
1075 f
->output_data
.mac
->menubar_active
= 0;
1078 /* Allocate a widget_value, blocking input. */
1081 xmalloc_widget_value ()
1083 widget_value
*value
;
1086 value
= malloc_widget_value ();
1092 /* This recursively calls free_widget_value on the tree of widgets.
1093 It must free all data that was malloc'ed for these widget_values.
1094 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1095 must be left alone. */
1098 free_menubar_widget_value_tree (wv
)
1103 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1105 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1107 free_menubar_widget_value_tree (wv
->contents
);
1108 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1112 free_menubar_widget_value_tree (wv
->next
);
1113 wv
->next
= (widget_value
*) 0xDEADBEEF;
1116 free_widget_value (wv
);
1120 /* Return a tree of widget_value structures for a menu bar item
1121 whose event type is ITEM_KEY (with string ITEM_NAME)
1122 and whose contents come from the list of keymaps MAPS. */
1124 static widget_value
*
1125 single_submenu (item_key
, item_name
, maps
)
1126 Lisp_Object item_key
, item_name
, maps
;
1128 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1130 int submenu_depth
= 0;
1133 Lisp_Object
*mapvec
;
1134 widget_value
**submenu_stack
;
1135 int previous_items
= menu_items_used
;
1136 int top_level_items
= 0;
1138 length
= Flength (maps
);
1139 len
= XINT (length
);
1141 /* Convert the list MAPS into a vector MAPVEC. */
1142 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1143 for (i
= 0; i
< len
; i
++)
1145 mapvec
[i
] = Fcar (maps
);
1149 menu_items_n_panes
= 0;
1151 /* Loop over the given keymaps, making a pane for each map.
1152 But don't make a pane that is empty--ignore that map instead. */
1153 for (i
= 0; i
< len
; i
++)
1155 if (SYMBOLP (mapvec
[i
])
1156 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1158 /* Here we have a command at top level in the menu bar
1159 as opposed to a submenu. */
1160 top_level_items
= 1;
1161 push_menu_pane (Qnil
, Qnil
);
1162 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1163 Qnil
, Qnil
, Qnil
, Qnil
);
1166 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1169 /* Create a tree of widget_value objects
1170 representing the panes and their items. */
1173 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1174 wv
= xmalloc_widget_value ();
1178 wv
->button_type
= BUTTON_TYPE_NONE
;
1184 /* Loop over all panes and items made during this call
1185 and construct a tree of widget_value objects.
1186 Ignore the panes and items made by previous calls to
1187 single_submenu, even though those are also in menu_items. */
1189 while (i
< menu_items_used
)
1191 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1193 submenu_stack
[submenu_depth
++] = save_wv
;
1198 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1201 save_wv
= submenu_stack
[--submenu_depth
];
1204 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1205 && submenu_depth
!= 0)
1206 i
+= MENU_ITEMS_PANE_LENGTH
;
1207 /* Ignore a nil in the item list.
1208 It's meaningful only for dialog boxes. */
1209 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1211 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1213 /* Create a new pane. */
1214 Lisp_Object pane_name
, prefix
;
1217 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1218 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1220 #ifndef HAVE_MULTILINGUAL_MENU
1221 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1223 pane_name
= ENCODE_SYSTEM (pane_name
);
1224 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1227 pane_string
= (NILP (pane_name
)
1228 ? "" : (char *) SDATA (pane_name
));
1229 /* If there is just one top-level pane, put all its items directly
1230 under the top-level menu. */
1231 if (menu_items_n_panes
== 1)
1234 /* If the pane has a meaningful name,
1235 make the pane a top-level menu item
1236 with its items as a submenu beneath it. */
1237 if (strcmp (pane_string
, ""))
1239 wv
= xmalloc_widget_value ();
1243 first_wv
->contents
= wv
;
1244 wv
->name
= pane_string
;
1245 /* Ignore the @ that means "separate pane".
1246 This is a kludge, but this isn't worth more time. */
1247 if (!NILP (prefix
) && wv
->name
[0] == '@')
1251 wv
->button_type
= BUTTON_TYPE_NONE
;
1256 i
+= MENU_ITEMS_PANE_LENGTH
;
1260 /* Create a new item within current pane. */
1261 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1264 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1265 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1266 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1267 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1268 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1269 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1270 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1272 #ifndef HAVE_MULTILINGUAL_MENU
1273 if (STRING_MULTIBYTE (item_name
))
1275 item_name
= ENCODE_SYSTEM (item_name
);
1276 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1279 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1281 descrip
= ENCODE_SYSTEM (descrip
);
1282 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1284 #endif /* not HAVE_MULTILINGUAL_MENU */
1286 wv
= xmalloc_widget_value ();
1290 save_wv
->contents
= wv
;
1292 wv
->name
= (char *) SDATA (item_name
);
1293 if (!NILP (descrip
))
1294 wv
->key
= (char *) SDATA (descrip
);
1296 /* The EMACS_INT cast avoids a warning. There's no problem
1297 as long as pointers have enough bits to hold small integers. */
1298 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1299 wv
->enabled
= !NILP (enable
);
1302 wv
->button_type
= BUTTON_TYPE_NONE
;
1303 else if (EQ (type
, QCradio
))
1304 wv
->button_type
= BUTTON_TYPE_RADIO
;
1305 else if (EQ (type
, QCtoggle
))
1306 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1310 wv
->selected
= !NILP (selected
);
1311 if (!STRINGP (help
))
1318 i
+= MENU_ITEMS_ITEM_LENGTH
;
1322 /* If we have just one "menu item"
1323 that was originally a button, return it by itself. */
1324 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1326 wv
= first_wv
->contents
;
1327 free_widget_value (first_wv
);
1334 /* Set the contents of the menubar widgets of frame F.
1335 The argument FIRST_TIME is currently ignored;
1336 it is set the first time this is called, from initialize_frame_menubar. */
1339 set_frame_menubar (f
, first_time
, deep_p
)
1344 int menubar_widget
= f
->output_data
.mac
->menubar_widget
;
1346 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1349 /* We must not change the menubar when actually in use. */
1350 if (f
->output_data
.mac
->menubar_active
)
1353 XSETFRAME (Vmenu_updating_frame
, f
);
1355 if (! menubar_widget
)
1357 else if (pending_menu_activation
&& !deep_p
)
1360 wv
= xmalloc_widget_value ();
1361 wv
->name
= "menubar";
1364 wv
->button_type
= BUTTON_TYPE_NONE
;
1370 /* Make a widget-value tree representing the entire menu trees. */
1372 struct buffer
*prev
= current_buffer
;
1374 int specpdl_count
= SPECPDL_INDEX ();
1375 int previous_menu_items_used
= f
->menu_bar_items_used
;
1376 Lisp_Object
*previous_items
1377 = (Lisp_Object
*) alloca (previous_menu_items_used
1378 * sizeof (Lisp_Object
));
1380 /* If we are making a new widget, its contents are empty,
1381 do always reinitialize them. */
1382 if (! menubar_widget
)
1383 previous_menu_items_used
= 0;
1385 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1386 specbind (Qinhibit_quit
, Qt
);
1387 /* Don't let the debugger step into this code
1388 because it is not reentrant. */
1389 specbind (Qdebug_on_next_call
, Qnil
);
1391 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1392 if (NILP (Voverriding_local_map_menu_flag
))
1394 specbind (Qoverriding_terminal_local_map
, Qnil
);
1395 specbind (Qoverriding_local_map
, Qnil
);
1398 set_buffer_internal_1 (XBUFFER (buffer
));
1400 /* Run the Lucid hook. */
1401 safe_run_hooks (Qactivate_menubar_hook
);
1402 /* If it has changed current-menubar from previous value,
1403 really recompute the menubar from the value. */
1404 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1405 call0 (Qrecompute_lucid_menubar
);
1406 safe_run_hooks (Qmenu_bar_update_hook
);
1407 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1409 items
= FRAME_MENU_BAR_ITEMS (f
);
1411 inhibit_garbage_collection ();
1413 /* Save the frame's previous menu bar contents data. */
1414 if (previous_menu_items_used
)
1415 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1416 previous_menu_items_used
* sizeof (Lisp_Object
));
1418 /* Fill in the current menu bar contents. */
1419 menu_items
= f
->menu_bar_vector
;
1420 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1422 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1424 Lisp_Object key
, string
, maps
;
1426 key
= XVECTOR (items
)->contents
[i
];
1427 string
= XVECTOR (items
)->contents
[i
+ 1];
1428 maps
= XVECTOR (items
)->contents
[i
+ 2];
1432 wv
= single_submenu (key
, string
, maps
);
1436 first_wv
->contents
= wv
;
1437 /* Don't set wv->name here; GC during the loop might relocate it. */
1439 wv
->button_type
= BUTTON_TYPE_NONE
;
1443 finish_menu_items ();
1445 set_buffer_internal_1 (prev
);
1446 unbind_to (specpdl_count
, Qnil
);
1448 /* If there has been no change in the Lisp-level contents
1449 of the menu bar, skip redisplaying it. Just exit. */
1451 for (i
= 0; i
< previous_menu_items_used
; i
++)
1452 if (menu_items_used
== i
1453 || (!Fequal (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1455 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1457 free_menubar_widget_value_tree (first_wv
);
1463 /* Now GC cannot happen during the lifetime of the widget_value,
1464 so it's safe to store data from a Lisp_String, as long as
1465 local copies are made when the actual menu is created.
1466 Windows takes care of this for normal string items, but
1467 not for owner-drawn items or additional item-info. */
1468 wv
= first_wv
->contents
;
1469 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1472 string
= XVECTOR (items
)->contents
[i
+ 1];
1475 wv
->name
= (char *) SDATA (string
);
1479 f
->menu_bar_vector
= menu_items
;
1480 f
->menu_bar_items_used
= menu_items_used
;
1485 /* Make a widget-value tree containing
1486 just the top level menu bar strings. */
1488 items
= FRAME_MENU_BAR_ITEMS (f
);
1489 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1493 string
= XVECTOR (items
)->contents
[i
+ 1];
1497 wv
= xmalloc_widget_value ();
1498 wv
->name
= (char *) SDATA (string
);
1501 wv
->button_type
= BUTTON_TYPE_NONE
;
1503 /* This prevents lwlib from assuming this
1504 menu item is really supposed to be empty. */
1505 /* The EMACS_INT cast avoids a warning.
1506 This value just has to be different from small integers. */
1507 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1512 first_wv
->contents
= wv
;
1516 /* Forget what we thought we knew about what is in the
1517 detailed contents of the menu bar menus.
1518 Changing the top level always destroys the contents. */
1519 f
->menu_bar_items_used
= 0;
1522 /* Create or update the menu bar widget. */
1526 /* Non-null value to indicate menubar has already been "created". */
1527 f
->output_data
.mac
->menubar_widget
= 1;
1530 int i
= MIN_MENU_ID
;
1531 MenuHandle menu
= GetMenuHandle (i
);
1532 while (menu
!= NULL
)
1536 menu
= GetMenuHandle (++i
);
1540 menu
= GetMenuHandle (i
);
1541 while (menu
!= NULL
)
1545 menu
= GetMenuHandle (++i
);
1549 fill_menubar (first_wv
->contents
);
1553 free_menubar_widget_value_tree (first_wv
);
1558 /* Called from Fx_create_frame to create the initial menubar of a frame
1559 before it is mapped, so that the window is mapped with the menubar already
1560 there instead of us tacking it on later and thrashing the window after it
1564 initialize_frame_menubar (f
)
1567 /* This function is called before the first chance to redisplay
1568 the frame. It has to be, so the frame will have the right size. */
1569 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1570 set_frame_menubar (f
, 1, 1);
1573 /* Get rid of the menu bar of frame F, and free its storage.
1574 This is used when deleting a frame, and when turning off the menu bar. */
1577 free_frame_menubar (f
)
1580 f
->output_data
.mac
->menubar_widget
= NULL
;
1584 /* mac_menu_show actually displays a menu using the panes and items in
1585 menu_items and returns the value selected from it; we assume input
1586 is blocked by the caller. */
1588 /* F is the frame the menu is for.
1589 X and Y are the frame-relative specified position,
1590 relative to the inside upper left corner of the frame F.
1591 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1592 KEYMAPS is 1 if this menu was specified with keymaps;
1593 in that case, we return a list containing the chosen item's value
1594 and perhaps also the pane's prefix.
1595 TITLE is the specified menu title.
1596 ERROR is a place to store an error message string in case of failure.
1597 (We return nil on failure, but the value doesn't actually matter.) */
1600 mac_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1611 int menu_item_choice
;
1612 int menu_item_selection
;
1615 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1616 widget_value
**submenu_stack
1617 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1618 Lisp_Object
*subprefix_stack
1619 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1620 int submenu_depth
= 0;
1625 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1627 *error
= "Empty menu";
1631 /* Create a tree of widget_value objects
1632 representing the panes and their items. */
1633 wv
= xmalloc_widget_value ();
1637 wv
->button_type
= BUTTON_TYPE_NONE
;
1642 /* Loop over all panes and items, filling in the tree. */
1644 while (i
< menu_items_used
)
1646 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1648 submenu_stack
[submenu_depth
++] = save_wv
;
1654 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1657 save_wv
= submenu_stack
[--submenu_depth
];
1661 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1662 && submenu_depth
!= 0)
1663 i
+= MENU_ITEMS_PANE_LENGTH
;
1664 /* Ignore a nil in the item list.
1665 It's meaningful only for dialog boxes. */
1666 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1668 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1670 /* Create a new pane. */
1671 Lisp_Object pane_name
, prefix
;
1673 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1674 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1675 #ifndef HAVE_MULTILINGUAL_MENU
1676 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1678 pane_name
= ENCODE_SYSTEM (pane_name
);
1679 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1682 pane_string
= (NILP (pane_name
)
1683 ? "" : (char *) SDATA (pane_name
));
1684 /* If there is just one top-level pane, put all its items directly
1685 under the top-level menu. */
1686 if (menu_items_n_panes
== 1)
1689 /* If the pane has a meaningful name,
1690 make the pane a top-level menu item
1691 with its items as a submenu beneath it. */
1692 if (!keymaps
&& strcmp (pane_string
, ""))
1694 wv
= xmalloc_widget_value ();
1698 first_wv
->contents
= wv
;
1699 wv
->name
= pane_string
;
1700 if (keymaps
&& !NILP (prefix
))
1704 wv
->button_type
= BUTTON_TYPE_NONE
;
1709 else if (first_pane
)
1715 i
+= MENU_ITEMS_PANE_LENGTH
;
1719 /* Create a new item within current pane. */
1720 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1722 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1723 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1724 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1725 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1726 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1727 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1728 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1730 #ifndef HAVE_MULTILINGUAL_MENU
1731 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1733 item_name
= ENCODE_SYSTEM (item_name
);
1734 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1736 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1738 descrip
= ENCODE_SYSTEM (descrip
);
1739 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1741 #endif /* not HAVE_MULTILINGUAL_MENU */
1743 wv
= xmalloc_widget_value ();
1747 save_wv
->contents
= wv
;
1748 wv
->name
= (char *) SDATA (item_name
);
1749 if (!NILP (descrip
))
1750 wv
->key
= (char *) SDATA (descrip
);
1752 /* Use the contents index as call_data, since we are
1753 restricted to 16-bits. */
1754 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1755 wv
->enabled
= !NILP (enable
);
1758 wv
->button_type
= BUTTON_TYPE_NONE
;
1759 else if (EQ (type
, QCtoggle
))
1760 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1761 else if (EQ (type
, QCradio
))
1762 wv
->button_type
= BUTTON_TYPE_RADIO
;
1766 wv
->selected
= !NILP (selected
);
1767 if (!STRINGP (help
))
1774 i
+= MENU_ITEMS_ITEM_LENGTH
;
1778 /* Deal with the title, if it is non-nil. */
1781 widget_value
*wv_title
= xmalloc_widget_value ();
1782 widget_value
*wv_sep
= xmalloc_widget_value ();
1784 /* Maybe replace this separator with a bitmap or owner-draw item
1785 so that it looks better. Having two separators looks odd. */
1786 wv_sep
->name
= "--";
1787 wv_sep
->next
= first_wv
->contents
;
1788 wv_sep
->help
= Qnil
;
1790 #ifndef HAVE_MULTILINGUAL_MENU
1791 if (STRING_MULTIBYTE (title
))
1792 title
= ENCODE_SYSTEM (title
);
1794 wv_title
->name
= (char *) SDATA (title
);
1795 wv_title
->enabled
= TRUE
;
1796 wv_title
->title
= TRUE
;
1797 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1798 wv_title
->help
= Qnil
;
1799 wv_title
->next
= wv_sep
;
1800 first_wv
->contents
= wv_title
;
1803 /* Actually create the menu. */
1804 menu
= NewMenu (POPUP_SUBMENU_ID
, "\p");
1805 submenu_id
= MIN_POPUP_SUBMENU_ID
;
1806 fill_submenu (menu
, first_wv
->contents
);
1808 /* Adjust coordinates to be root-window-relative. */
1812 #if TARGET_API_MAC_CARBON
1813 SetPort (GetWindowPort (FRAME_MAC_WINDOW (f
)));
1815 SetPort (FRAME_MAC_WINDOW (f
));
1818 LocalToGlobal (&pos
);
1820 /* No selection has been chosen yet. */
1821 menu_item_choice
= 0;
1822 menu_item_selection
= 0;
1824 InsertMenu (menu
, -1);
1826 /* Display the menu. */
1827 menu_item_choice
= PopUpMenuSelect (menu
, pos
.v
, pos
.h
, 0);
1828 menu_item_selection
= LoWord (menu_item_choice
);
1830 /* Get the refcon to find the correct item*/
1831 if (menu_item_selection
)
1833 menu
= GetMenuHandle (HiWord (menu_item_choice
));
1835 GetMenuItemRefCon (menu
, menu_item_selection
, &refcon
);
1840 /* Clean up extraneous mouse events which might have been generated
1842 discard_mouse_events ();
1845 /* Free the widget_value objects we used to specify the
1847 free_menubar_widget_value_tree (first_wv
);
1849 /* delete all menus */
1851 int i
= MIN_POPUP_SUBMENU_ID
;
1852 MenuHandle submenu
= GetMenuHandle (i
);
1853 while (menu
!= NULL
)
1857 menu
= GetMenuHandle (++i
);
1861 DeleteMenu (POPUP_SUBMENU_ID
);
1864 /* Find the selected item, and its pane, to return
1865 the proper value. */
1866 if (menu_item_selection
!= 0)
1868 Lisp_Object prefix
, entry
;
1870 prefix
= entry
= Qnil
;
1872 while (i
< menu_items_used
)
1874 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1876 subprefix_stack
[submenu_depth
++] = prefix
;
1880 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1882 prefix
= subprefix_stack
[--submenu_depth
];
1885 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1888 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1889 i
+= MENU_ITEMS_PANE_LENGTH
;
1891 /* Ignore a nil in the item list.
1892 It's meaningful only for dialog boxes. */
1893 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1898 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1899 if ((int) (EMACS_INT
) refcon
== i
)
1905 entry
= Fcons (entry
, Qnil
);
1907 entry
= Fcons (prefix
, entry
);
1908 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1909 if (!NILP (subprefix_stack
[j
]))
1910 entry
= Fcons (subprefix_stack
[j
], entry
);
1914 i
+= MENU_ITEMS_ITEM_LENGTH
;
1924 /* Construct native Mac OS menubar based on widget_value tree. */
1927 mac_dialog (widget_value
*wv
)
1931 char **button_labels
;
1938 WindowPtr window_ptr
;
1941 EventRecord event_record
;
1943 int control_part_code
;
1946 dialog_name
= wv
->name
;
1947 nb_buttons
= dialog_name
[1] - '0';
1948 left_count
= nb_buttons
- (dialog_name
[4] - '0');
1949 button_labels
= (char **) alloca (sizeof (char *) * nb_buttons
);
1950 ref_cons
= (UInt32
*) alloca (sizeof (UInt32
) * nb_buttons
);
1953 prompt
= (char *) alloca (strlen (wv
->value
) + 1);
1954 strcpy (prompt
, wv
->value
);
1958 for (i
= 0; i
< nb_buttons
; i
++)
1960 button_labels
[i
] = wv
->value
;
1961 button_labels
[i
] = (char *) alloca (strlen (wv
->value
) + 1);
1962 strcpy (button_labels
[i
], wv
->value
);
1963 c2pstr (button_labels
[i
]);
1964 ref_cons
[i
] = (UInt32
) wv
->call_data
;
1968 window_ptr
= GetNewCWindow (DIALOG_WINDOW_RESOURCE
, NULL
, (WindowPtr
) -1);
1970 #if TARGET_API_MAC_CARBON
1971 SetPort (GetWindowPort (window_ptr
));
1973 SetPort (window_ptr
);
1977 /* Left and right margins in the dialog are 13 pixels each.*/
1979 /* Calculate width of dialog box: 8 pixels on each side of the text
1980 label in each button, 12 pixels between buttons. */
1981 for (i
= 0; i
< nb_buttons
; i
++)
1982 dialog_width
+= StringWidth (button_labels
[i
]) + 16 + 12;
1984 if (left_count
!= 0 && nb_buttons
- left_count
!= 0)
1987 dialog_width
= max (dialog_width
, StringWidth (prompt
) + 26);
1989 SizeWindow (window_ptr
, dialog_width
, 78, 0);
1990 ShowWindow (window_ptr
);
1992 #if TARGET_API_MAC_CARBON
1993 SetPort (GetWindowPort (window_ptr
));
1995 SetPort (window_ptr
);
2001 DrawString (prompt
);
2004 for (i
= 0; i
< nb_buttons
; i
++)
2006 int button_width
= StringWidth (button_labels
[i
]) + 16;
2007 SetRect (&rect
, left
, 45, left
+ button_width
, 65);
2008 ch
= NewControl (window_ptr
, &rect
, button_labels
[i
], 1, 0, 0, 0,
2009 kControlPushButtonProc
, ref_cons
[i
]);
2010 left
+= button_width
+ 12;
2011 if (i
== left_count
- 1)
2018 if (WaitNextEvent (mDownMask
, &event_record
, 10, NULL
))
2019 if (event_record
.what
== mouseDown
)
2021 part_code
= FindWindow (event_record
.where
, &window_ptr
);
2022 if (part_code
== inContent
)
2024 mouse
= event_record
.where
;
2025 GlobalToLocal (&mouse
);
2026 control_part_code
= FindControl (mouse
, window_ptr
, &ch
);
2027 if (control_part_code
== kControlButtonPart
)
2028 if (TrackControl (ch
, mouse
, NULL
))
2029 i
= GetControlReference (ch
);
2034 DisposeWindow (window_ptr
);
2039 static char * button_names
[] = {
2040 "button1", "button2", "button3", "button4", "button5",
2041 "button6", "button7", "button8", "button9", "button10" };
2044 mac_dialog_show (f
, keymaps
, title
, error
)
2050 int i
, nb_buttons
=0;
2051 char dialog_name
[6];
2052 int menu_item_selection
;
2054 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2056 /* Number of elements seen so far, before boundary. */
2058 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2059 int boundary_seen
= 0;
2063 if (menu_items_n_panes
> 1)
2065 *error
= "Multiple panes in dialog box";
2069 /* Create a tree of widget_value objects
2070 representing the text label and buttons. */
2072 Lisp_Object pane_name
, prefix
;
2074 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
2075 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
2076 pane_string
= (NILP (pane_name
)
2077 ? "" : (char *) SDATA (pane_name
));
2078 prev_wv
= xmalloc_widget_value ();
2079 prev_wv
->value
= pane_string
;
2080 if (keymaps
&& !NILP (prefix
))
2082 prev_wv
->enabled
= 1;
2083 prev_wv
->name
= "message";
2084 prev_wv
->help
= Qnil
;
2087 /* Loop over all panes and items, filling in the tree. */
2088 i
= MENU_ITEMS_PANE_LENGTH
;
2089 while (i
< menu_items_used
)
2092 /* Create a new item within current pane. */
2093 Lisp_Object item_name
, enable
, descrip
, help
;
2095 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
2096 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
2098 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
2099 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
2101 if (NILP (item_name
))
2103 free_menubar_widget_value_tree (first_wv
);
2104 *error
= "Submenu in dialog items";
2107 if (EQ (item_name
, Qquote
))
2109 /* This is the boundary between left-side elts
2110 and right-side elts. Stop incrementing right_count. */
2115 if (nb_buttons
>= 9)
2117 free_menubar_widget_value_tree (first_wv
);
2118 *error
= "Too many dialog items";
2122 wv
= xmalloc_widget_value ();
2124 wv
->name
= (char *) button_names
[nb_buttons
];
2125 if (!NILP (descrip
))
2126 wv
->key
= (char *) SDATA (descrip
);
2127 wv
->value
= (char *) SDATA (item_name
);
2128 wv
->call_data
= (void *) i
;
2129 /* menu item is identified by its index in menu_items table */
2130 wv
->enabled
= !NILP (enable
);
2134 if (! boundary_seen
)
2138 i
+= MENU_ITEMS_ITEM_LENGTH
;
2141 /* If the boundary was not specified,
2142 by default put half on the left and half on the right. */
2143 if (! boundary_seen
)
2144 left_count
= nb_buttons
- nb_buttons
/ 2;
2146 wv
= xmalloc_widget_value ();
2147 wv
->name
= dialog_name
;
2150 /* Dialog boxes use a really stupid name encoding
2151 which specifies how many buttons to use
2152 and how many buttons are on the right.
2153 The Q means something also. */
2154 dialog_name
[0] = 'Q';
2155 dialog_name
[1] = '0' + nb_buttons
;
2156 dialog_name
[2] = 'B';
2157 dialog_name
[3] = 'R';
2158 /* Number of buttons to put on the right. */
2159 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2161 wv
->contents
= first_wv
;
2165 /* Actually create the dialog. */
2167 menu_item_selection
= mac_dialog (first_wv
);
2169 menu_item_selection
= 0;
2172 /* Free the widget_value objects we used to specify the contents. */
2173 free_menubar_widget_value_tree (first_wv
);
2175 /* Find the selected item, and its pane, to return the proper
2177 if (menu_item_selection
!= 0)
2183 while (i
< menu_items_used
)
2187 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2190 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2191 i
+= MENU_ITEMS_PANE_LENGTH
;
2196 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2197 if (menu_item_selection
== i
)
2201 entry
= Fcons (entry
, Qnil
);
2203 entry
= Fcons (prefix
, entry
);
2207 i
+= MENU_ITEMS_ITEM_LENGTH
;
2214 #endif /* HAVE_DIALOGS */
2217 /* Is this item a separator? */
2219 name_is_separator (name
)
2224 /* Check if name string consists of only dashes ('-'). */
2225 while (*name
== '-') name
++;
2226 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2227 or "--deep-shadow". We don't implement them yet, se we just treat
2228 them like normal separators. */
2229 return (*name
== '\0' || start
+ 2 == name
);
2233 add_menu_item (MenuHandle menu
, widget_value
*wv
, int submenu
,
2239 if (name_is_separator (wv
->name
))
2240 AppendMenu (menu
, "\p-");
2243 AppendMenu (menu
, "\pX");
2245 #if TARGET_API_MAC_CARBON
2246 pos
= CountMenuItems (menu
);
2248 pos
= CountMItems (menu
);
2251 strcpy (item_name
, "");
2252 strncat (item_name
, wv
->name
, 255);
2253 if (wv
->key
!= NULL
)
2255 strncat (item_name
, " ", 255);
2256 strncat (item_name
, wv
->key
, 255);
2260 SetMenuItemText (menu
, pos
, item_name
);
2262 if (wv
->enabled
&& !force_disable
)
2263 #if TARGET_API_MAC_CARBON
2264 EnableMenuItem (menu
, pos
);
2266 EnableItem (menu
, pos
);
2269 #if TARGET_API_MAC_CARBON
2270 DisableMenuItem (menu
, pos
);
2272 DisableItem (menu
, pos
);
2275 /* Draw radio buttons and tickboxes. */
2277 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2278 wv
->button_type
== BUTTON_TYPE_RADIO
))
2279 SetItemMark (menu
, pos
, checkMark
);
2281 SetItemMark (menu
, pos
, noMark
);
2285 SetMenuItemRefCon (menu
, pos
, (UInt32
) wv
->call_data
);
2287 if (submenu
!= NULL
)
2288 SetMenuItemHierarchicalID (menu
, pos
, submenu
);
2291 /* Construct native Mac OS menubar based on widget_value tree. */
2294 fill_submenu (MenuHandle menu
, widget_value
*wv
)
2296 for ( ; wv
!= NULL
; wv
= wv
->next
)
2299 int cur_submenu
= submenu_id
++;
2300 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2301 fill_submenu (submenu
, wv
->contents
);
2302 InsertMenu (submenu
, -1);
2303 add_menu_item (menu
, wv
, cur_submenu
, 0);
2306 add_menu_item (menu
, wv
, NULL
, 0);
2310 /* Construct native Mac OS menu based on widget_value tree. */
2313 fill_menu (MenuHandle menu
, widget_value
*wv
)
2315 for ( ; wv
!= NULL
; wv
= wv
->next
)
2318 int cur_submenu
= submenu_id
++;
2319 MenuHandle submenu
= NewMenu (cur_submenu
, "\pX");
2320 fill_submenu (submenu
, wv
->contents
);
2321 InsertMenu (submenu
, -1);
2322 add_menu_item (menu
, wv
, cur_submenu
, 0);
2325 add_menu_item (menu
, wv
, NULL
, 0);
2328 /* Construct native Mac OS menubar based on widget_value tree. */
2331 fill_menubar (widget_value
*wv
)
2335 submenu_id
= MIN_SUBMENU_ID
;
2337 for (id
= MIN_MENU_ID
; wv
!= NULL
; wv
= wv
->next
, id
++)
2342 strncpy (title
, wv
->name
, 255);
2345 menu
= NewMenu (id
, title
);
2348 fill_menu (menu
, wv
->contents
);
2350 InsertMenu (menu
, 0);
2354 #endif /* HAVE_MENUS */
2360 staticpro (&menu_items
);
2363 Qdebug_on_next_call
= intern ("debug-on-next-call");
2364 staticpro (&Qdebug_on_next_call
);
2366 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2367 doc
: /* Frame for which we are updating a menu.
2368 The enable predicate for a menu command should check this variable. */);
2369 Vmenu_updating_frame
= Qnil
;
2371 defsubr (&Sx_popup_menu
);
2373 defsubr (&Sx_popup_dialog
);