*** empty log message ***
[emacs.git] / src / macmenu.c
blob14bfe92cb25bc3392822d5f90004995185e763e7
1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
24 #include <config.h>
26 #include <stdio.h>
28 #include "lisp.h"
29 #include "termhooks.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "frame.h"
33 #include "window.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "charset.h"
37 #include "coding.h"
39 #if !TARGET_API_MAC_CARBON
40 #include <MacTypes.h>
41 #include <Menus.h>
42 #include <QuickDraw.h>
43 #include <ToolUtils.h>
44 #include <Fonts.h>
45 #include <Controls.h>
46 #include <Windows.h>
47 #include <Events.h>
48 #if defined (__MRC__) || (__MSL__ >= 0x6000)
49 #include <ControlDefinitions.h>
50 #endif
51 #endif /* not TARGET_API_MAC_CARBON */
53 /* This may include sys/types.h, and that somehow loses
54 if this is not done before the other system files. */
55 #include "macterm.h"
57 /* Load sys/types.h if not already loaded.
58 In some systems loading it twice is suicidal. */
59 #ifndef makedev
60 #include <sys/types.h>
61 #endif
63 #include "dispextern.h"
65 enum mac_menu_kind { /* Menu ID range */
66 MAC_MENU_APPLE, /* 0 (Reserved by Apple) */
67 MAC_MENU_MENU_BAR, /* 1 .. 233 */
68 MAC_MENU_M_APPLE, /* 234 (== M_APPLE) */
69 MAC_MENU_POPUP, /* 235 */
70 MAC_MENU_DRIVER, /* 236 .. 255 (Reserved) */
71 MAC_MENU_MENU_BAR_SUB, /* 256 .. 16383 */
72 MAC_MENU_POPUP_SUB, /* 16384 .. 32767 */
73 MAC_MENU_END /* 32768 */
76 static const int min_menu_id[] = {0, 1, 234, 235, 236, 256, 16384, 32768};
78 #define DIALOG_WINDOW_RESOURCE 130
80 #define HAVE_DIALOGS 1
82 #undef HAVE_MULTILINGUAL_MENU
83 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
85 /******************************************************************/
86 /* Definitions copied from lwlib.h */
88 typedef void * XtPointer;
90 enum button_type
92 BUTTON_TYPE_NONE,
93 BUTTON_TYPE_TOGGLE,
94 BUTTON_TYPE_RADIO
97 /* This structure is based on the one in ../lwlib/lwlib.h, modified
98 for Mac OS. */
99 typedef struct _widget_value
101 /* name of widget */
102 Lisp_Object lname;
103 char* name;
104 /* value (meaning depend on widget type) */
105 char* value;
106 /* keyboard equivalent. no implications for XtTranslations */
107 Lisp_Object lkey;
108 char* key;
109 /* Help string or nil if none.
110 GC finds this string through the frame's menu_bar_vector
111 or through menu_items. */
112 Lisp_Object help;
113 /* true if enabled */
114 Boolean enabled;
115 /* true if selected */
116 Boolean selected;
117 /* The type of a button. */
118 enum button_type button_type;
119 /* true if menu title */
120 Boolean title;
121 #if 0
122 /* true if was edited (maintained by get_value) */
123 Boolean edited;
124 /* true if has changed (maintained by lw library) */
125 change_type change;
126 /* true if this widget itself has changed,
127 but not counting the other widgets found in the `next' field. */
128 change_type this_one_change;
129 #endif
130 /* Contents of the sub-widgets, also selected slot for checkbox */
131 struct _widget_value* contents;
132 /* data passed to callback */
133 XtPointer call_data;
134 /* next one in the list */
135 struct _widget_value* next;
136 #if 0
137 /* slot for the toolkit dependent part. Always initialize to NULL. */
138 void* toolkit_data;
139 /* tell us if we should free the toolkit data slot when freeing the
140 widget_value itself. */
141 Boolean free_toolkit_data;
143 /* we resource the widget_value structures; this points to the next
144 one on the free list if this one has been deallocated.
146 struct _widget_value *free_list;
147 #endif
148 } widget_value;
150 /* Assumed by other routines to zero area returned. */
151 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
152 0, (sizeof (widget_value)))
153 #define free_widget_value(wv) xfree (wv)
155 /******************************************************************/
157 #ifndef TRUE
158 #define TRUE 1
159 #define FALSE 0
160 #endif /* no TRUE */
162 Lisp_Object Qdebug_on_next_call;
164 extern Lisp_Object Vmenu_updating_frame;
166 extern Lisp_Object Qmenu_bar, Qmac_apple_event;
168 extern Lisp_Object QCtoggle, QCradio;
170 extern Lisp_Object Voverriding_local_map;
171 extern Lisp_Object Voverriding_local_map_menu_flag;
173 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
175 extern Lisp_Object Qmenu_bar_update_hook;
177 void set_frame_menubar P_ ((FRAME_PTR, int, int));
179 #if TARGET_API_MAC_CARBON
180 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
181 #else
182 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
183 #endif
185 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
186 Lisp_Object, Lisp_Object, Lisp_Object,
187 Lisp_Object, Lisp_Object));
188 #ifdef HAVE_DIALOGS
189 static Lisp_Object mac_dialog_show P_ ((FRAME_PTR, int, Lisp_Object,
190 Lisp_Object, char **));
191 #endif
192 static Lisp_Object mac_menu_show P_ ((struct frame *, int, int, int, int,
193 Lisp_Object, char **));
194 static void keymap_panes P_ ((Lisp_Object *, int, int));
195 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
196 int, int));
197 static void list_of_panes P_ ((Lisp_Object));
198 static void list_of_items P_ ((Lisp_Object));
200 static void find_and_call_menu_selection P_ ((FRAME_PTR, int, Lisp_Object,
201 void *));
202 static int fill_menu P_ ((MenuHandle, widget_value *, enum mac_menu_kind, int));
203 static void fill_menubar P_ ((widget_value *, int));
204 static void dispose_menus P_ ((enum mac_menu_kind, int));
207 /* This holds a Lisp vector that holds the results of decoding
208 the keymaps or alist-of-alists that specify a menu.
210 It describes the panes and items within the panes.
212 Each pane is described by 3 elements in the vector:
213 t, the pane name, the pane's prefix key.
214 Then follow the pane's items, with 5 elements per item:
215 the item string, the enable flag, the item's value,
216 the definition, and the equivalent keyboard key's description string.
218 In some cases, multiple levels of menus may be described.
219 A single vector slot containing nil indicates the start of a submenu.
220 A single vector slot containing lambda indicates the end of a submenu.
221 The submenu follows a menu item which is the way to reach the submenu.
223 A single vector slot containing quote indicates that the
224 following items should appear on the right of a dialog box.
226 Using a Lisp vector to hold this information while we decode it
227 takes care of protecting all the data from GC. */
229 #define MENU_ITEMS_PANE_NAME 1
230 #define MENU_ITEMS_PANE_PREFIX 2
231 #define MENU_ITEMS_PANE_LENGTH 3
233 enum menu_item_idx
235 MENU_ITEMS_ITEM_NAME = 0,
236 MENU_ITEMS_ITEM_ENABLE,
237 MENU_ITEMS_ITEM_VALUE,
238 MENU_ITEMS_ITEM_EQUIV_KEY,
239 MENU_ITEMS_ITEM_DEFINITION,
240 MENU_ITEMS_ITEM_TYPE,
241 MENU_ITEMS_ITEM_SELECTED,
242 MENU_ITEMS_ITEM_HELP,
243 MENU_ITEMS_ITEM_LENGTH
246 static Lisp_Object menu_items;
248 /* Number of slots currently allocated in menu_items. */
249 static int menu_items_allocated;
251 /* This is the index in menu_items of the first empty slot. */
252 static int menu_items_used;
254 /* The number of panes currently recorded in menu_items,
255 excluding those within submenus. */
256 static int menu_items_n_panes;
258 /* Current depth within submenus. */
259 static int menu_items_submenu_depth;
261 /* This is set nonzero after the user activates the menu bar, and set
262 to zero again after the menu bars are redisplayed by prepare_menu_bar.
263 While it is nonzero, all calls to set_frame_menubar go deep.
265 I don't understand why this is needed, but it does seem to be
266 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
268 int pending_menu_activation;
270 /* Initialize the menu_items structure if we haven't already done so.
271 Also mark it as currently empty. */
273 static void
274 init_menu_items ()
276 if (NILP (menu_items))
278 menu_items_allocated = 60;
279 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
282 menu_items_used = 0;
283 menu_items_n_panes = 0;
284 menu_items_submenu_depth = 0;
287 /* Call at the end of generating the data in menu_items. */
289 static void
290 finish_menu_items ()
294 /* Call when finished using the data for the current menu
295 in menu_items. */
297 static void
298 discard_menu_items ()
300 /* Free the structure if it is especially large.
301 Otherwise, hold on to it, to save time. */
302 if (menu_items_allocated > 200)
304 menu_items = Qnil;
305 menu_items_allocated = 0;
309 /* This undoes save_menu_items, and it is called by the specpdl unwind
310 mechanism. */
312 static Lisp_Object
313 restore_menu_items (saved)
314 Lisp_Object saved;
316 menu_items = XCAR (saved);
317 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
318 saved = XCDR (saved);
319 menu_items_used = XINT (XCAR (saved));
320 saved = XCDR (saved);
321 menu_items_n_panes = XINT (XCAR (saved));
322 saved = XCDR (saved);
323 menu_items_submenu_depth = XINT (XCAR (saved));
324 return Qnil;
327 /* Push the whole state of menu_items processing onto the specpdl.
328 It will be restored when the specpdl is unwound. */
330 static void
331 save_menu_items ()
333 Lisp_Object saved = list4 (menu_items,
334 make_number (menu_items_used),
335 make_number (menu_items_n_panes),
336 make_number (menu_items_submenu_depth));
337 record_unwind_protect (restore_menu_items, saved);
338 menu_items = Qnil;
341 /* Make the menu_items vector twice as large. */
343 static void
344 grow_menu_items ()
346 Lisp_Object old;
347 int old_size = menu_items_allocated;
348 old = menu_items;
350 menu_items_allocated *= 2;
352 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
353 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
354 old_size * sizeof (Lisp_Object));
357 /* Begin a submenu. */
359 static void
360 push_submenu_start ()
362 if (menu_items_used + 1 > menu_items_allocated)
363 grow_menu_items ();
365 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
366 menu_items_submenu_depth++;
369 /* End a submenu. */
371 static void
372 push_submenu_end ()
374 if (menu_items_used + 1 > menu_items_allocated)
375 grow_menu_items ();
377 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
378 menu_items_submenu_depth--;
381 /* Indicate boundary between left and right. */
383 static void
384 push_left_right_boundary ()
386 if (menu_items_used + 1 > menu_items_allocated)
387 grow_menu_items ();
389 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
392 /* Start a new menu pane in menu_items.
393 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
395 static void
396 push_menu_pane (name, prefix_vec)
397 Lisp_Object name, prefix_vec;
399 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
400 grow_menu_items ();
402 if (menu_items_submenu_depth == 0)
403 menu_items_n_panes++;
404 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
405 XVECTOR (menu_items)->contents[menu_items_used++] = name;
406 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
409 /* Push one menu item into the current pane. NAME is the string to
410 display. ENABLE if non-nil means this item can be selected. KEY
411 is the key generated by choosing this item, or nil if this item
412 doesn't really have a definition. DEF is the definition of this
413 item. EQUIV is the textual description of the keyboard equivalent
414 for this item (or nil if none). TYPE is the type of this menu
415 item, one of nil, `toggle' or `radio'. */
417 static void
418 push_menu_item (name, enable, key, def, equiv, type, selected, help)
419 Lisp_Object name, enable, key, def, equiv, type, selected, help;
421 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
422 grow_menu_items ();
424 XVECTOR (menu_items)->contents[menu_items_used++] = name;
425 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
426 XVECTOR (menu_items)->contents[menu_items_used++] = key;
427 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
428 XVECTOR (menu_items)->contents[menu_items_used++] = def;
429 XVECTOR (menu_items)->contents[menu_items_used++] = type;
430 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
431 XVECTOR (menu_items)->contents[menu_items_used++] = help;
434 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
435 and generate menu panes for them in menu_items.
436 If NOTREAL is nonzero,
437 don't bother really computing whether an item is enabled. */
439 static void
440 keymap_panes (keymaps, nmaps, notreal)
441 Lisp_Object *keymaps;
442 int nmaps;
443 int notreal;
445 int mapno;
447 init_menu_items ();
449 /* Loop over the given keymaps, making a pane for each map.
450 But don't make a pane that is empty--ignore that map instead.
451 P is the number of panes we have made so far. */
452 for (mapno = 0; mapno < nmaps; mapno++)
453 single_keymap_panes (keymaps[mapno],
454 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
456 finish_menu_items ();
459 /* Args passed between single_keymap_panes and single_menu_item. */
460 struct skp
462 Lisp_Object pending_maps;
463 int maxdepth, notreal;
466 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
467 void *));
469 /* This is a recursive subroutine of keymap_panes.
470 It handles one keymap, KEYMAP.
471 The other arguments are passed along
472 or point to local variables of the previous function.
473 If NOTREAL is nonzero, only check for equivalent key bindings, don't
474 evaluate expressions in menu items and don't make any menu.
476 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
478 static void
479 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
480 Lisp_Object keymap;
481 Lisp_Object pane_name;
482 Lisp_Object prefix;
483 int notreal;
484 int maxdepth;
486 struct skp skp;
487 struct gcpro gcpro1;
489 skp.pending_maps = Qnil;
490 skp.maxdepth = maxdepth;
491 skp.notreal = notreal;
493 if (maxdepth <= 0)
494 return;
496 push_menu_pane (pane_name, prefix);
498 GCPRO1 (skp.pending_maps);
499 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
500 UNGCPRO;
502 /* Process now any submenus which want to be panes at this level. */
503 while (CONSP (skp.pending_maps))
505 Lisp_Object elt, eltcdr, string;
506 elt = XCAR (skp.pending_maps);
507 eltcdr = XCDR (elt);
508 string = XCAR (eltcdr);
509 /* We no longer discard the @ from the beginning of the string here.
510 Instead, we do this in mac_menu_show. */
511 single_keymap_panes (Fcar (elt), string,
512 XCDR (eltcdr), notreal, maxdepth - 1);
513 skp.pending_maps = XCDR (skp.pending_maps);
517 /* This is a subroutine of single_keymap_panes that handles one
518 keymap entry.
519 KEY is a key in a keymap and ITEM is its binding.
520 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
521 separate panes.
522 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
523 evaluate expressions in menu items and don't make any menu.
524 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
526 static void
527 single_menu_item (key, item, dummy, skp_v)
528 Lisp_Object key, item, dummy;
529 void *skp_v;
531 Lisp_Object map, item_string, enabled;
532 struct gcpro gcpro1, gcpro2;
533 int res;
534 struct skp *skp = skp_v;
536 /* Parse the menu item and leave the result in item_properties. */
537 GCPRO2 (key, item);
538 res = parse_menu_item (item, skp->notreal, 0);
539 UNGCPRO;
540 if (!res)
541 return; /* Not a menu item. */
543 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
545 if (skp->notreal)
547 /* We don't want to make a menu, just traverse the keymaps to
548 precompute equivalent key bindings. */
549 if (!NILP (map))
550 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
551 return;
554 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
555 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
557 if (!NILP (map) && SREF (item_string, 0) == '@')
559 if (!NILP (enabled))
560 /* An enabled separate pane. Remember this to handle it later. */
561 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
562 skp->pending_maps);
563 return;
566 push_menu_item (item_string, enabled, key,
567 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
568 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
569 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
570 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
571 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
573 /* Display a submenu using the toolkit. */
574 if (! (NILP (map) || NILP (enabled)))
576 push_submenu_start ();
577 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
578 push_submenu_end ();
582 /* Push all the panes and items of a menu described by the
583 alist-of-alists MENU.
584 This handles old-fashioned calls to x-popup-menu. */
586 static void
587 list_of_panes (menu)
588 Lisp_Object menu;
590 Lisp_Object tail;
592 init_menu_items ();
594 for (tail = menu; CONSP (tail); tail = XCDR (tail))
596 Lisp_Object elt, pane_name, pane_data;
597 elt = XCAR (tail);
598 pane_name = Fcar (elt);
599 CHECK_STRING (pane_name);
600 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
601 pane_data = Fcdr (elt);
602 CHECK_CONS (pane_data);
603 list_of_items (pane_data);
606 finish_menu_items ();
609 /* Push the items in a single pane defined by the alist PANE. */
611 static void
612 list_of_items (pane)
613 Lisp_Object pane;
615 Lisp_Object tail, item, item1;
617 for (tail = pane; CONSP (tail); tail = XCDR (tail))
619 item = XCAR (tail);
620 if (STRINGP (item))
621 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
622 Qnil, Qnil, Qnil, Qnil);
623 else if (CONSP (item))
625 item1 = XCAR (item);
626 CHECK_STRING (item1);
627 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
628 Qt, Qnil, Qnil, Qnil, Qnil);
630 else
631 push_left_right_boundary ();
636 static Lisp_Object
637 cleanup_popup_menu (arg)
638 Lisp_Object arg;
640 discard_menu_items ();
641 return Qnil;
644 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
645 doc: /* Pop up a deck-of-cards menu and return user's selection.
646 POSITION is a position specification. This is either a mouse button event
647 or a list ((XOFFSET YOFFSET) WINDOW)
648 where XOFFSET and YOFFSET are positions in pixels from the top left
649 corner of WINDOW. (WINDOW may be a window or a frame object.)
650 This controls the position of the top left of the menu as a whole.
651 If POSITION is t, it means to use the current mouse position.
653 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
654 The menu items come from key bindings that have a menu string as well as
655 a definition; actually, the "definition" in such a key binding looks like
656 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
657 the keymap as a top-level element.
659 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
660 Otherwise, REAL-DEFINITION should be a valid key binding definition.
662 You can also use a list of keymaps as MENU.
663 Then each keymap makes a separate pane.
665 When MENU is a keymap or a list of keymaps, the return value is the
666 list of events corresponding to the user's choice. Note that
667 `x-popup-menu' does not actually execute the command bound to that
668 sequence of events.
670 Alternatively, you can specify a menu of multiple panes
671 with a list of the form (TITLE PANE1 PANE2...),
672 where each pane is a list of form (TITLE ITEM1 ITEM2...).
673 Each ITEM is normally a cons cell (STRING . VALUE);
674 but a string can appear as an item--that makes a nonselectable line
675 in the menu.
676 With this form of menu, the return value is VALUE from the chosen item.
678 If POSITION is nil, don't display the menu at all, just precalculate the
679 cached information about equivalent key sequences.
681 If the user gets rid of the menu without making a valid choice, for
682 instance by clicking the mouse away from a valid choice or by typing
683 keyboard input, then this normally results in a quit and
684 `x-popup-menu' does not return. But if POSITION is a mouse button
685 event (indicating that the user invoked the menu with the mouse) then
686 no quit occurs and `x-popup-menu' returns nil. */)
687 (position, menu)
688 Lisp_Object position, menu;
690 Lisp_Object keymap, tem;
691 int xpos = 0, ypos = 0;
692 Lisp_Object title;
693 char *error_name = NULL;
694 Lisp_Object selection;
695 FRAME_PTR f = NULL;
696 Lisp_Object x, y, window;
697 int keymaps = 0;
698 int for_click = 0;
699 int specpdl_count = SPECPDL_INDEX ();
700 struct gcpro gcpro1;
702 #ifdef HAVE_MENUS
703 if (! NILP (position))
705 check_mac ();
707 /* Decode the first argument: find the window and the coordinates. */
708 if (EQ (position, Qt)
709 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
710 || EQ (XCAR (position), Qtool_bar)
711 || EQ (XCAR (position), Qmac_apple_event))))
713 /* Use the mouse's current position. */
714 FRAME_PTR new_f = SELECTED_FRAME ();
715 Lisp_Object bar_window;
716 enum scroll_bar_part part;
717 unsigned long time;
719 if (mouse_position_hook)
720 (*mouse_position_hook) (&new_f, 1, &bar_window,
721 &part, &x, &y, &time);
722 if (new_f != 0)
723 XSETFRAME (window, new_f);
724 else
726 window = selected_window;
727 XSETFASTINT (x, 0);
728 XSETFASTINT (y, 0);
731 else
733 tem = Fcar (position);
734 if (CONSP (tem))
736 window = Fcar (Fcdr (position));
737 x = XCAR (tem);
738 y = Fcar (XCDR (tem));
740 else
742 for_click = 1;
743 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
744 window = Fcar (tem); /* POSN_WINDOW (tem) */
745 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
746 x = Fcar (tem);
747 y = Fcdr (tem);
751 CHECK_NUMBER (x);
752 CHECK_NUMBER (y);
754 /* Decode where to put the menu. */
756 if (FRAMEP (window))
758 f = XFRAME (window);
759 xpos = 0;
760 ypos = 0;
762 else if (WINDOWP (window))
764 CHECK_LIVE_WINDOW (window);
765 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
767 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
768 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
770 else
771 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
772 but I don't want to make one now. */
773 CHECK_WINDOW (window);
775 xpos += XINT (x);
776 ypos += XINT (y);
778 XSETFRAME (Vmenu_updating_frame, f);
780 else
781 Vmenu_updating_frame = Qnil;
782 #endif /* HAVE_MENUS */
784 title = Qnil;
785 GCPRO1 (title);
787 /* Decode the menu items from what was specified. */
789 keymap = get_keymap (menu, 0, 0);
790 if (CONSP (keymap))
792 /* We were given a keymap. Extract menu info from the keymap. */
793 Lisp_Object prompt;
795 /* Extract the detailed info to make one pane. */
796 keymap_panes (&menu, 1, NILP (position));
798 /* Search for a string appearing directly as an element of the keymap.
799 That string is the title of the menu. */
800 prompt = Fkeymap_prompt (keymap);
801 if (NILP (title) && !NILP (prompt))
802 title = prompt;
804 /* Make that be the pane title of the first pane. */
805 if (!NILP (prompt) && menu_items_n_panes >= 0)
806 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
808 keymaps = 1;
810 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
812 /* We were given a list of keymaps. */
813 int nmaps = XFASTINT (Flength (menu));
814 Lisp_Object *maps
815 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
816 int i;
818 title = Qnil;
820 /* The first keymap that has a prompt string
821 supplies the menu title. */
822 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
824 Lisp_Object prompt;
826 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
828 prompt = Fkeymap_prompt (keymap);
829 if (NILP (title) && !NILP (prompt))
830 title = prompt;
833 /* Extract the detailed info to make one pane. */
834 keymap_panes (maps, nmaps, NILP (position));
836 /* Make the title be the pane title of the first pane. */
837 if (!NILP (title) && menu_items_n_panes >= 0)
838 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
840 keymaps = 1;
842 else
844 /* We were given an old-fashioned menu. */
845 title = Fcar (menu);
846 CHECK_STRING (title);
848 list_of_panes (Fcdr (menu));
850 keymaps = 0;
853 if (NILP (position))
855 discard_menu_items ();
856 UNGCPRO;
857 return Qnil;
860 #ifdef HAVE_MENUS
861 /* Display them in a menu. */
862 record_unwind_protect (cleanup_popup_menu, Qnil);
863 BLOCK_INPUT;
865 selection = mac_menu_show (f, xpos, ypos, for_click,
866 keymaps, title, &error_name);
867 UNBLOCK_INPUT;
868 unbind_to (specpdl_count, Qnil);
870 UNGCPRO;
871 #endif /* HAVE_MENUS */
873 if (error_name) error (error_name);
874 return selection;
877 #ifdef HAVE_MENUS
879 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
880 doc: /* Pop up a dialog box and return user's selection.
881 POSITION specifies which frame to use.
882 This is normally a mouse button event or a window or frame.
883 If POSITION is t, it means to use the frame the mouse is on.
884 The dialog box appears in the middle of the specified frame.
886 CONTENTS specifies the alternatives to display in the dialog box.
887 It is a list of the form (DIALOG ITEM1 ITEM2...).
888 Each ITEM is a cons cell (STRING . VALUE).
889 The return value is VALUE from the chosen item.
891 An ITEM may also be just a string--that makes a nonselectable item.
892 An ITEM may also be nil--that means to put all preceding items
893 on the left of the dialog box and all following items on the right.
894 \(By default, approximately half appear on each side.)
896 If HEADER is non-nil, the frame title for the box is "Information",
897 otherwise it is "Question".
899 If the user gets rid of the dialog box without making a valid choice,
900 for instance using the window manager, then this produces a quit and
901 `x-popup-dialog' does not return. */)
902 (position, contents, header)
903 Lisp_Object position, contents, header;
905 FRAME_PTR f = NULL;
906 Lisp_Object window;
908 check_mac ();
910 /* Decode the first argument: find the window or frame to use. */
911 if (EQ (position, Qt)
912 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
913 || EQ (XCAR (position), Qtool_bar)
914 || EQ (XCAR (position), Qmac_apple_event))))
916 #if 0 /* Using the frame the mouse is on may not be right. */
917 /* Use the mouse's current position. */
918 FRAME_PTR new_f = SELECTED_FRAME ();
919 Lisp_Object bar_window;
920 enum scroll_bar_part part;
921 unsigned long time;
922 Lisp_Object x, y;
924 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
926 if (new_f != 0)
927 XSETFRAME (window, new_f);
928 else
929 window = selected_window;
930 #endif
931 window = selected_window;
933 else if (CONSP (position))
935 Lisp_Object tem;
936 tem = Fcar (position);
937 if (CONSP (tem))
938 window = Fcar (Fcdr (position));
939 else
941 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
942 window = Fcar (tem); /* POSN_WINDOW (tem) */
945 else if (WINDOWP (position) || FRAMEP (position))
946 window = position;
947 else
948 window = Qnil;
950 /* Decode where to put the menu. */
952 if (FRAMEP (window))
953 f = XFRAME (window);
954 else if (WINDOWP (window))
956 CHECK_LIVE_WINDOW (window);
957 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
959 else
960 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
961 but I don't want to make one now. */
962 CHECK_WINDOW (window);
964 #ifndef HAVE_DIALOGS
965 /* Display a menu with these alternatives
966 in the middle of frame F. */
968 Lisp_Object x, y, frame, newpos;
969 XSETFRAME (frame, f);
970 XSETINT (x, x_pixel_width (f) / 2);
971 XSETINT (y, x_pixel_height (f) / 2);
972 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
974 return Fx_popup_menu (newpos,
975 Fcons (Fcar (contents), Fcons (contents, Qnil)));
977 #else /* HAVE_DIALOGS */
979 Lisp_Object title;
980 char *error_name;
981 Lisp_Object selection;
982 int specpdl_count = SPECPDL_INDEX ();
984 /* Decode the dialog items from what was specified. */
985 title = Fcar (contents);
986 CHECK_STRING (title);
988 list_of_panes (Fcons (contents, Qnil));
990 /* Display them in a dialog box. */
991 record_unwind_protect (cleanup_popup_menu, Qnil);
992 BLOCK_INPUT;
993 selection = mac_dialog_show (f, 0, title, header, &error_name);
994 UNBLOCK_INPUT;
995 unbind_to (specpdl_count, Qnil);
997 if (error_name) error (error_name);
998 return selection;
1000 #endif /* HAVE_DIALOGS */
1003 /* Activate the menu bar of frame F.
1004 This is called from keyboard.c when it gets the
1005 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1007 To activate the menu bar, we use the button-press event location
1008 that was saved in saved_menu_event_location.
1010 But first we recompute the menu bar contents (the whole tree).
1012 The reason for saving the button event until here, instead of
1013 passing it to the toolkit right away, is that we can safely
1014 execute Lisp code. */
1016 void
1017 x_activate_menubar (f)
1018 FRAME_PTR f;
1020 SInt32 menu_choice;
1021 SInt16 menu_id, menu_item;
1022 extern Point saved_menu_event_location;
1024 set_frame_menubar (f, 0, 1);
1025 BLOCK_INPUT;
1027 menu_choice = MenuSelect (saved_menu_event_location);
1028 menu_id = HiWord (menu_choice);
1029 menu_item = LoWord (menu_choice);
1031 #if !TARGET_API_MAC_CARBON
1032 if (menu_id == min_menu_id[MAC_MENU_M_APPLE])
1033 do_apple_menu (menu_item);
1034 else
1035 #endif
1036 if (menu_id)
1038 MenuHandle menu = GetMenuHandle (menu_id);
1040 if (menu)
1042 UInt32 refcon;
1044 GetMenuItemRefCon (menu, menu_item, &refcon);
1045 find_and_call_menu_selection (f, f->menu_bar_items_used,
1046 f->menu_bar_vector, (void *) refcon);
1050 HiliteMenu (0);
1052 UNBLOCK_INPUT;
1055 /* Find the menu selection and store it in the keyboard buffer.
1056 F is the frame the menu is on.
1057 MENU_BAR_ITEMS_USED is the length of VECTOR.
1058 VECTOR is an array of menu events for the whole menu. */
1060 static void
1061 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
1062 FRAME_PTR f;
1063 int menu_bar_items_used;
1064 Lisp_Object vector;
1065 void *client_data;
1067 Lisp_Object prefix, entry;
1068 Lisp_Object *subprefix_stack;
1069 int submenu_depth = 0;
1070 int i;
1072 entry = Qnil;
1073 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
1074 prefix = Qnil;
1075 i = 0;
1077 while (i < menu_bar_items_used)
1079 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1081 subprefix_stack[submenu_depth++] = prefix;
1082 prefix = entry;
1083 i++;
1085 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1087 prefix = subprefix_stack[--submenu_depth];
1088 i++;
1090 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1092 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1093 i += MENU_ITEMS_PANE_LENGTH;
1095 else
1097 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1098 /* The EMACS_INT cast avoids a warning. There's no problem
1099 as long as pointers have enough bits to hold small integers. */
1100 if ((int) (EMACS_INT) client_data == i)
1102 int j;
1103 struct input_event buf;
1104 Lisp_Object frame;
1105 EVENT_INIT (buf);
1107 XSETFRAME (frame, f);
1108 buf.kind = MENU_BAR_EVENT;
1109 buf.frame_or_window = frame;
1110 buf.arg = frame;
1111 kbd_buffer_store_event (&buf);
1113 for (j = 0; j < submenu_depth; j++)
1114 if (!NILP (subprefix_stack[j]))
1116 buf.kind = MENU_BAR_EVENT;
1117 buf.frame_or_window = frame;
1118 buf.arg = subprefix_stack[j];
1119 kbd_buffer_store_event (&buf);
1122 if (!NILP (prefix))
1124 buf.kind = MENU_BAR_EVENT;
1125 buf.frame_or_window = frame;
1126 buf.arg = prefix;
1127 kbd_buffer_store_event (&buf);
1130 buf.kind = MENU_BAR_EVENT;
1131 buf.frame_or_window = frame;
1132 buf.arg = entry;
1133 kbd_buffer_store_event (&buf);
1135 return;
1137 i += MENU_ITEMS_ITEM_LENGTH;
1142 /* Allocate a widget_value, blocking input. */
1144 widget_value *
1145 xmalloc_widget_value ()
1147 widget_value *value;
1149 BLOCK_INPUT;
1150 value = malloc_widget_value ();
1151 UNBLOCK_INPUT;
1153 return value;
1156 /* This recursively calls free_widget_value on the tree of widgets.
1157 It must free all data that was malloc'ed for these widget_values.
1158 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1159 must be left alone. */
1161 void
1162 free_menubar_widget_value_tree (wv)
1163 widget_value *wv;
1165 if (! wv) return;
1167 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1169 if (wv->contents && (wv->contents != (widget_value*)1))
1171 free_menubar_widget_value_tree (wv->contents);
1172 wv->contents = (widget_value *) 0xDEADBEEF;
1174 if (wv->next)
1176 free_menubar_widget_value_tree (wv->next);
1177 wv->next = (widget_value *) 0xDEADBEEF;
1179 BLOCK_INPUT;
1180 free_widget_value (wv);
1181 UNBLOCK_INPUT;
1184 /* Set up data in menu_items for a menu bar item
1185 whose event type is ITEM_KEY (with string ITEM_NAME)
1186 and whose contents come from the list of keymaps MAPS. */
1188 static int
1189 parse_single_submenu (item_key, item_name, maps)
1190 Lisp_Object item_key, item_name, maps;
1192 Lisp_Object length;
1193 int len;
1194 Lisp_Object *mapvec;
1195 int i;
1196 int top_level_items = 0;
1198 length = Flength (maps);
1199 len = XINT (length);
1201 /* Convert the list MAPS into a vector MAPVEC. */
1202 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1203 for (i = 0; i < len; i++)
1205 mapvec[i] = Fcar (maps);
1206 maps = Fcdr (maps);
1209 /* Loop over the given keymaps, making a pane for each map.
1210 But don't make a pane that is empty--ignore that map instead. */
1211 for (i = 0; i < len; i++)
1213 if (!KEYMAPP (mapvec[i]))
1215 /* Here we have a command at top level in the menu bar
1216 as opposed to a submenu. */
1217 top_level_items = 1;
1218 push_menu_pane (Qnil, Qnil);
1219 push_menu_item (item_name, Qt, item_key, mapvec[i],
1220 Qnil, Qnil, Qnil, Qnil);
1222 else
1224 Lisp_Object prompt;
1225 prompt = Fkeymap_prompt (mapvec[i]);
1226 single_keymap_panes (mapvec[i],
1227 !NILP (prompt) ? prompt : item_name,
1228 item_key, 0, 10);
1232 return top_level_items;
1235 /* Create a tree of widget_value objects
1236 representing the panes and items
1237 in menu_items starting at index START, up to index END. */
1239 static widget_value *
1240 digest_single_submenu (start, end, top_level_items)
1241 int start, end, top_level_items;
1243 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1244 int i;
1245 int submenu_depth = 0;
1246 widget_value **submenu_stack;
1247 int panes_seen = 0;
1249 submenu_stack
1250 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1251 wv = xmalloc_widget_value ();
1252 wv->name = "menu";
1253 wv->value = 0;
1254 wv->enabled = 1;
1255 wv->button_type = BUTTON_TYPE_NONE;
1256 wv->help = Qnil;
1257 first_wv = wv;
1258 save_wv = 0;
1259 prev_wv = 0;
1261 /* Loop over all panes and items made by the preceding call
1262 to parse_single_submenu and construct a tree of widget_value objects.
1263 Ignore the panes and items used by previous calls to
1264 digest_single_submenu, even though those are also in menu_items. */
1265 i = start;
1266 while (i < end)
1268 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1270 submenu_stack[submenu_depth++] = save_wv;
1271 save_wv = prev_wv;
1272 prev_wv = 0;
1273 i++;
1275 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1277 prev_wv = save_wv;
1278 save_wv = submenu_stack[--submenu_depth];
1279 i++;
1281 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1282 && submenu_depth != 0)
1283 i += MENU_ITEMS_PANE_LENGTH;
1284 /* Ignore a nil in the item list.
1285 It's meaningful only for dialog boxes. */
1286 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1287 i += 1;
1288 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1290 /* Create a new pane. */
1291 Lisp_Object pane_name, prefix;
1292 char *pane_string;
1294 panes_seen++;
1296 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1297 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1299 #ifndef HAVE_MULTILINGUAL_MENU
1300 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1302 pane_name = ENCODE_MENU_STRING (pane_name);
1303 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1305 #endif
1306 pane_string = (NILP (pane_name)
1307 ? "" : (char *) SDATA (pane_name));
1308 /* If there is just one top-level pane, put all its items directly
1309 under the top-level menu. */
1310 if (menu_items_n_panes == 1)
1311 pane_string = "";
1313 /* If the pane has a meaningful name,
1314 make the pane a top-level menu item
1315 with its items as a submenu beneath it. */
1316 if (strcmp (pane_string, ""))
1318 wv = xmalloc_widget_value ();
1319 if (save_wv)
1320 save_wv->next = wv;
1321 else
1322 first_wv->contents = wv;
1323 wv->lname = pane_name;
1324 /* Set value to 1 so update_submenu_strings can handle '@' */
1325 wv->value = (char *)1;
1326 wv->enabled = 1;
1327 wv->button_type = BUTTON_TYPE_NONE;
1328 wv->help = Qnil;
1329 save_wv = wv;
1331 else
1332 save_wv = first_wv;
1334 prev_wv = 0;
1335 i += MENU_ITEMS_PANE_LENGTH;
1337 else
1339 /* Create a new item within current pane. */
1340 Lisp_Object item_name, enable, descrip, def, type, selected;
1341 Lisp_Object help;
1343 /* All items should be contained in panes. */
1344 if (panes_seen == 0)
1345 abort ();
1347 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1348 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1349 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1350 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1351 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1352 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1353 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1355 #ifndef HAVE_MULTILINGUAL_MENU
1356 if (STRING_MULTIBYTE (item_name))
1358 item_name = ENCODE_MENU_STRING (item_name);
1359 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1362 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1364 descrip = ENCODE_MENU_STRING (descrip);
1365 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1367 #endif /* not HAVE_MULTILINGUAL_MENU */
1369 wv = xmalloc_widget_value ();
1370 if (prev_wv)
1371 prev_wv->next = wv;
1372 else
1373 save_wv->contents = wv;
1375 wv->lname = item_name;
1376 if (!NILP (descrip))
1377 wv->lkey = descrip;
1378 wv->value = 0;
1379 /* The EMACS_INT cast avoids a warning. There's no problem
1380 as long as pointers have enough bits to hold small integers. */
1381 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1382 wv->enabled = !NILP (enable);
1384 if (NILP (type))
1385 wv->button_type = BUTTON_TYPE_NONE;
1386 else if (EQ (type, QCradio))
1387 wv->button_type = BUTTON_TYPE_RADIO;
1388 else if (EQ (type, QCtoggle))
1389 wv->button_type = BUTTON_TYPE_TOGGLE;
1390 else
1391 abort ();
1393 wv->selected = !NILP (selected);
1394 if (! STRINGP (help))
1395 help = Qnil;
1397 wv->help = help;
1399 prev_wv = wv;
1401 i += MENU_ITEMS_ITEM_LENGTH;
1405 /* If we have just one "menu item"
1406 that was originally a button, return it by itself. */
1407 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1409 wv = first_wv->contents;
1410 free_widget_value (first_wv);
1411 return wv;
1414 return first_wv;
1417 /* Walk through the widget_value tree starting at FIRST_WV and update
1418 the char * pointers from the corresponding lisp values.
1419 We do this after building the whole tree, since GC may happen while the
1420 tree is constructed, and small strings are relocated. So we must wait
1421 until no GC can happen before storing pointers into lisp values. */
1422 static void
1423 update_submenu_strings (first_wv)
1424 widget_value *first_wv;
1426 widget_value *wv;
1428 for (wv = first_wv; wv; wv = wv->next)
1430 if (STRINGP (wv->lname))
1432 wv->name = SDATA (wv->lname);
1434 /* Ignore the @ that means "separate pane".
1435 This is a kludge, but this isn't worth more time. */
1436 if (wv->value == (char *)1)
1438 if (wv->name[0] == '@')
1439 wv->name++;
1440 wv->value = 0;
1444 if (STRINGP (wv->lkey))
1445 wv->key = SDATA (wv->lkey);
1447 if (wv->contents)
1448 update_submenu_strings (wv->contents);
1453 /* Event handler function that pops down a menu on C-g. We can only pop
1454 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1456 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1457 static pascal OSStatus
1458 menu_quit_handler (nextHandler, theEvent, userData)
1459 EventHandlerCallRef nextHandler;
1460 EventRef theEvent;
1461 void* userData;
1463 OSStatus err;
1464 UInt32 keyCode;
1465 UInt32 keyModifiers;
1466 extern int mac_quit_char_modifiers;
1467 extern int mac_quit_char_keycode;
1469 err = GetEventParameter (theEvent, kEventParamKeyCode,
1470 typeUInt32, NULL, sizeof(UInt32), NULL, &keyCode);
1472 if (err == noErr)
1473 err = GetEventParameter (theEvent, kEventParamKeyModifiers,
1474 typeUInt32, NULL, sizeof(UInt32),
1475 NULL, &keyModifiers);
1477 if (err == noErr && keyCode == mac_quit_char_keycode
1478 && keyModifiers == mac_quit_char_modifiers)
1480 MenuRef menu = userData != 0
1481 ? (MenuRef)userData : AcquireRootMenu ();
1483 CancelMenuTracking (menu, true, 0);
1484 if (!userData) ReleaseMenu (menu);
1485 return noErr;
1488 return CallNextEventHandler (nextHandler, theEvent);
1490 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1492 /* Add event handler to all menus that belong to KIND so we can detect C-g.
1493 MENU_HANDLE is the root menu of the tracking session to dismiss
1494 when C-g is detected. NULL means the menu bar.
1495 If CancelMenuTracking isn't available, do nothing. */
1497 static void
1498 install_menu_quit_handler (kind, menu_handle)
1499 enum mac_menu_kind kind;
1500 MenuHandle menu_handle;
1502 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1503 static const EventTypeSpec typesList[] =
1504 {{kEventClassKeyboard, kEventRawKeyDown}};
1505 int id;
1507 #if MAC_OS_X_VERSION_MIN_REQUIRED == 1020
1508 if (CancelMenuTracking == NULL)
1509 return;
1510 #endif
1511 for (id = min_menu_id[kind]; id < min_menu_id[kind + 1]; id++)
1513 MenuHandle menu = GetMenuHandle (id);
1515 if (menu == NULL)
1516 break;
1517 InstallMenuEventHandler (menu, menu_quit_handler,
1518 GetEventTypeCount (typesList),
1519 typesList, menu_handle, NULL);
1521 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1524 /* Set the contents of the menubar widgets of frame F.
1525 The argument FIRST_TIME is currently ignored;
1526 it is set the first time this is called, from initialize_frame_menubar. */
1528 void
1529 set_frame_menubar (f, first_time, deep_p)
1530 FRAME_PTR f;
1531 int first_time;
1532 int deep_p;
1534 int menubar_widget = f->output_data.mac->menubar_widget;
1535 Lisp_Object items;
1536 widget_value *wv, *first_wv, *prev_wv = 0;
1537 int i, last_i = 0;
1538 int *submenu_start, *submenu_end;
1539 int *submenu_top_level_items, *submenu_n_panes;
1541 XSETFRAME (Vmenu_updating_frame, f);
1543 if (! menubar_widget)
1544 deep_p = 1;
1545 else if (pending_menu_activation && !deep_p)
1546 deep_p = 1;
1548 if (deep_p)
1550 /* Make a widget-value tree representing the entire menu trees. */
1552 struct buffer *prev = current_buffer;
1553 Lisp_Object buffer;
1554 int specpdl_count = SPECPDL_INDEX ();
1555 int previous_menu_items_used = f->menu_bar_items_used;
1556 Lisp_Object *previous_items
1557 = (Lisp_Object *) alloca (previous_menu_items_used
1558 * sizeof (Lisp_Object));
1560 /* If we are making a new widget, its contents are empty,
1561 do always reinitialize them. */
1562 if (! menubar_widget)
1563 previous_menu_items_used = 0;
1565 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1566 specbind (Qinhibit_quit, Qt);
1567 /* Don't let the debugger step into this code
1568 because it is not reentrant. */
1569 specbind (Qdebug_on_next_call, Qnil);
1571 record_unwind_save_match_data ();
1572 if (NILP (Voverriding_local_map_menu_flag))
1574 specbind (Qoverriding_terminal_local_map, Qnil);
1575 specbind (Qoverriding_local_map, Qnil);
1578 set_buffer_internal_1 (XBUFFER (buffer));
1580 /* Run the Lucid hook. */
1581 safe_run_hooks (Qactivate_menubar_hook);
1583 /* If it has changed current-menubar from previous value,
1584 really recompute the menubar from the value. */
1585 if (! NILP (Vlucid_menu_bar_dirty_flag))
1586 call0 (Qrecompute_lucid_menubar);
1587 safe_run_hooks (Qmenu_bar_update_hook);
1588 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1590 items = FRAME_MENU_BAR_ITEMS (f);
1592 /* Save the frame's previous menu bar contents data. */
1593 if (previous_menu_items_used)
1594 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1595 previous_menu_items_used * sizeof (Lisp_Object));
1597 /* Fill in menu_items with the current menu bar contents.
1598 This can evaluate Lisp code. */
1599 save_menu_items ();
1601 menu_items = f->menu_bar_vector;
1602 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1603 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1604 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1605 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1606 submenu_top_level_items
1607 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1608 init_menu_items ();
1609 for (i = 0; i < XVECTOR (items)->size; i += 4)
1611 Lisp_Object key, string, maps;
1613 last_i = i;
1615 key = XVECTOR (items)->contents[i];
1616 string = XVECTOR (items)->contents[i + 1];
1617 maps = XVECTOR (items)->contents[i + 2];
1618 if (NILP (string))
1619 break;
1621 submenu_start[i] = menu_items_used;
1623 menu_items_n_panes = 0;
1624 submenu_top_level_items[i]
1625 = parse_single_submenu (key, string, maps);
1626 submenu_n_panes[i] = menu_items_n_panes;
1628 submenu_end[i] = menu_items_used;
1631 finish_menu_items ();
1633 /* Convert menu_items into widget_value trees
1634 to display the menu. This cannot evaluate Lisp code. */
1636 wv = xmalloc_widget_value ();
1637 wv->name = "menubar";
1638 wv->value = 0;
1639 wv->enabled = 1;
1640 wv->button_type = BUTTON_TYPE_NONE;
1641 wv->help = Qnil;
1642 first_wv = wv;
1644 for (i = 0; i < last_i; i += 4)
1646 menu_items_n_panes = submenu_n_panes[i];
1647 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1648 submenu_top_level_items[i]);
1649 if (prev_wv)
1650 prev_wv->next = wv;
1651 else
1652 first_wv->contents = wv;
1653 /* Don't set wv->name here; GC during the loop might relocate it. */
1654 wv->enabled = 1;
1655 wv->button_type = BUTTON_TYPE_NONE;
1656 prev_wv = wv;
1659 set_buffer_internal_1 (prev);
1661 /* If there has been no change in the Lisp-level contents
1662 of the menu bar, skip redisplaying it. Just exit. */
1664 /* Compare the new menu items with the ones computed last time. */
1665 for (i = 0; i < previous_menu_items_used; i++)
1666 if (menu_items_used == i
1667 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1668 break;
1669 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1671 /* The menu items have not changed. Don't bother updating
1672 the menus in any form, since it would be a no-op. */
1673 free_menubar_widget_value_tree (first_wv);
1674 discard_menu_items ();
1675 unbind_to (specpdl_count, Qnil);
1676 return;
1679 /* The menu items are different, so store them in the frame. */
1680 f->menu_bar_vector = menu_items;
1681 f->menu_bar_items_used = menu_items_used;
1683 /* This calls restore_menu_items to restore menu_items, etc.,
1684 as they were outside. */
1685 unbind_to (specpdl_count, Qnil);
1687 /* Now GC cannot happen during the lifetime of the widget_value,
1688 so it's safe to store data from a Lisp_String. */
1689 wv = first_wv->contents;
1690 for (i = 0; i < XVECTOR (items)->size; i += 4)
1692 Lisp_Object string;
1693 string = XVECTOR (items)->contents[i + 1];
1694 if (NILP (string))
1695 break;
1696 wv->name = (char *) SDATA (string);
1697 update_submenu_strings (wv->contents);
1698 wv = wv->next;
1702 else
1704 /* Make a widget-value tree containing
1705 just the top level menu bar strings. */
1707 wv = xmalloc_widget_value ();
1708 wv->name = "menubar";
1709 wv->value = 0;
1710 wv->enabled = 1;
1711 wv->button_type = BUTTON_TYPE_NONE;
1712 wv->help = Qnil;
1713 first_wv = wv;
1715 items = FRAME_MENU_BAR_ITEMS (f);
1716 for (i = 0; i < XVECTOR (items)->size; i += 4)
1718 Lisp_Object string;
1720 string = XVECTOR (items)->contents[i + 1];
1721 if (NILP (string))
1722 break;
1724 wv = xmalloc_widget_value ();
1725 wv->name = (char *) SDATA (string);
1726 wv->value = 0;
1727 wv->enabled = 1;
1728 wv->button_type = BUTTON_TYPE_NONE;
1729 wv->help = Qnil;
1730 /* This prevents lwlib from assuming this
1731 menu item is really supposed to be empty. */
1732 /* The EMACS_INT cast avoids a warning.
1733 This value just has to be different from small integers. */
1734 wv->call_data = (void *) (EMACS_INT) (-1);
1736 if (prev_wv)
1737 prev_wv->next = wv;
1738 else
1739 first_wv->contents = wv;
1740 prev_wv = wv;
1743 /* Forget what we thought we knew about what is in the
1744 detailed contents of the menu bar menus.
1745 Changing the top level always destroys the contents. */
1746 f->menu_bar_items_used = 0;
1749 /* Create or update the menu bar widget. */
1751 BLOCK_INPUT;
1753 /* Non-null value to indicate menubar has already been "created". */
1754 f->output_data.mac->menubar_widget = 1;
1756 fill_menubar (first_wv->contents, deep_p);
1758 /* Add event handler so we can detect C-g. */
1759 install_menu_quit_handler (MAC_MENU_MENU_BAR, NULL);
1760 install_menu_quit_handler (MAC_MENU_MENU_BAR_SUB, NULL);
1761 free_menubar_widget_value_tree (first_wv);
1763 UNBLOCK_INPUT;
1766 /* Get rid of the menu bar of frame F, and free its storage.
1767 This is used when deleting a frame, and when turning off the menu bar. */
1769 void
1770 free_frame_menubar (f)
1771 FRAME_PTR f;
1773 f->output_data.mac->menubar_widget = 0;
1777 static Lisp_Object
1778 pop_down_menu (arg)
1779 Lisp_Object arg;
1781 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
1782 FRAME_PTR f = p->pointer;
1783 MenuHandle menu = GetMenuHandle (min_menu_id[MAC_MENU_POPUP]);
1785 BLOCK_INPUT;
1787 /* Must reset this manually because the button release event is not
1788 passed to Emacs event loop. */
1789 FRAME_MAC_DISPLAY_INFO (f)->grabbed = 0;
1791 /* delete all menus */
1792 dispose_menus (MAC_MENU_POPUP_SUB, 0);
1793 DeleteMenu (min_menu_id[MAC_MENU_POPUP]);
1794 DisposeMenu (menu);
1796 UNBLOCK_INPUT;
1798 return Qnil;
1801 /* Mac_menu_show actually displays a menu using the panes and items in
1802 menu_items and returns the value selected from it; we assume input
1803 is blocked by the caller. */
1805 /* F is the frame the menu is for.
1806 X and Y are the frame-relative specified position,
1807 relative to the inside upper left corner of the frame F.
1808 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1809 KEYMAPS is 1 if this menu was specified with keymaps;
1810 in that case, we return a list containing the chosen item's value
1811 and perhaps also the pane's prefix.
1812 TITLE is the specified menu title.
1813 ERROR is a place to store an error message string in case of failure.
1814 (We return nil on failure, but the value doesn't actually matter.) */
1816 static Lisp_Object
1817 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1818 FRAME_PTR f;
1819 int x;
1820 int y;
1821 int for_click;
1822 int keymaps;
1823 Lisp_Object title;
1824 char **error;
1826 int i;
1827 UInt32 refcon;
1828 int menu_item_choice;
1829 int menu_item_selection;
1830 MenuHandle menu;
1831 Point pos;
1832 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1833 widget_value **submenu_stack
1834 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1835 Lisp_Object *subprefix_stack
1836 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1837 int submenu_depth = 0;
1839 int first_pane;
1840 int specpdl_count = SPECPDL_INDEX ();
1842 *error = NULL;
1844 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1846 *error = "Empty menu";
1847 return Qnil;
1850 /* Create a tree of widget_value objects
1851 representing the panes and their items. */
1852 wv = xmalloc_widget_value ();
1853 wv->name = "menu";
1854 wv->value = 0;
1855 wv->enabled = 1;
1856 wv->button_type = BUTTON_TYPE_NONE;
1857 wv->help = Qnil;
1858 first_wv = wv;
1859 first_pane = 1;
1861 /* Loop over all panes and items, filling in the tree. */
1862 i = 0;
1863 while (i < menu_items_used)
1865 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1867 submenu_stack[submenu_depth++] = save_wv;
1868 save_wv = prev_wv;
1869 prev_wv = 0;
1870 first_pane = 1;
1871 i++;
1873 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1875 prev_wv = save_wv;
1876 save_wv = submenu_stack[--submenu_depth];
1877 first_pane = 0;
1878 i++;
1880 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1881 && submenu_depth != 0)
1882 i += MENU_ITEMS_PANE_LENGTH;
1883 /* Ignore a nil in the item list.
1884 It's meaningful only for dialog boxes. */
1885 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1886 i += 1;
1887 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1889 /* Create a new pane. */
1890 Lisp_Object pane_name, prefix;
1891 char *pane_string;
1893 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1894 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1896 #ifndef HAVE_MULTILINGUAL_MENU
1897 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1899 pane_name = ENCODE_MENU_STRING (pane_name);
1900 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1902 #endif
1903 pane_string = (NILP (pane_name)
1904 ? "" : (char *) SDATA (pane_name));
1905 /* If there is just one top-level pane, put all its items directly
1906 under the top-level menu. */
1907 if (menu_items_n_panes == 1)
1908 pane_string = "";
1910 /* If the pane has a meaningful name,
1911 make the pane a top-level menu item
1912 with its items as a submenu beneath it. */
1913 if (!keymaps && strcmp (pane_string, ""))
1915 wv = xmalloc_widget_value ();
1916 if (save_wv)
1917 save_wv->next = wv;
1918 else
1919 first_wv->contents = wv;
1920 wv->name = pane_string;
1921 if (keymaps && !NILP (prefix))
1922 wv->name++;
1923 wv->value = 0;
1924 wv->enabled = 1;
1925 wv->button_type = BUTTON_TYPE_NONE;
1926 wv->help = Qnil;
1927 save_wv = wv;
1928 prev_wv = 0;
1930 else if (first_pane)
1932 save_wv = wv;
1933 prev_wv = 0;
1935 first_pane = 0;
1936 i += MENU_ITEMS_PANE_LENGTH;
1938 else
1940 /* Create a new item within current pane. */
1941 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1942 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1943 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1944 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1945 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1946 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1947 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1948 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1950 #ifndef HAVE_MULTILINGUAL_MENU
1951 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1953 item_name = ENCODE_MENU_STRING (item_name);
1954 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1957 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1959 descrip = ENCODE_MENU_STRING (descrip);
1960 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1962 #endif /* not HAVE_MULTILINGUAL_MENU */
1964 wv = xmalloc_widget_value ();
1965 if (prev_wv)
1966 prev_wv->next = wv;
1967 else
1968 save_wv->contents = wv;
1969 wv->name = (char *) SDATA (item_name);
1970 if (!NILP (descrip))
1971 wv->key = (char *) SDATA (descrip);
1972 wv->value = 0;
1973 /* Use the contents index as call_data, since we are
1974 restricted to 16-bits. */
1975 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1976 wv->enabled = !NILP (enable);
1978 if (NILP (type))
1979 wv->button_type = BUTTON_TYPE_NONE;
1980 else if (EQ (type, QCtoggle))
1981 wv->button_type = BUTTON_TYPE_TOGGLE;
1982 else if (EQ (type, QCradio))
1983 wv->button_type = BUTTON_TYPE_RADIO;
1984 else
1985 abort ();
1987 wv->selected = !NILP (selected);
1989 if (! STRINGP (help))
1990 help = Qnil;
1992 wv->help = help;
1994 prev_wv = wv;
1996 i += MENU_ITEMS_ITEM_LENGTH;
2000 /* Deal with the title, if it is non-nil. */
2001 if (!NILP (title))
2003 widget_value *wv_title = xmalloc_widget_value ();
2004 widget_value *wv_sep = xmalloc_widget_value ();
2006 /* Maybe replace this separator with a bitmap or owner-draw item
2007 so that it looks better. Having two separators looks odd. */
2008 wv_sep->name = "--";
2009 wv_sep->next = first_wv->contents;
2010 wv_sep->help = Qnil;
2012 #ifndef HAVE_MULTILINGUAL_MENU
2013 if (STRING_MULTIBYTE (title))
2014 title = ENCODE_MENU_STRING (title);
2015 #endif
2017 wv_title->name = (char *) SDATA (title);
2018 wv_title->enabled = FALSE;
2019 wv_title->title = TRUE;
2020 wv_title->button_type = BUTTON_TYPE_NONE;
2021 wv_title->help = Qnil;
2022 wv_title->next = wv_sep;
2023 first_wv->contents = wv_title;
2026 /* Actually create the menu. */
2027 menu = NewMenu (min_menu_id[MAC_MENU_POPUP], "\p");
2028 InsertMenu (menu, -1);
2029 fill_menu (menu, first_wv->contents, MAC_MENU_POPUP_SUB,
2030 min_menu_id[MAC_MENU_POPUP_SUB]);
2032 /* Free the widget_value objects we used to specify the
2033 contents. */
2034 free_menubar_widget_value_tree (first_wv);
2036 /* Adjust coordinates to be root-window-relative. */
2037 pos.h = x;
2038 pos.v = y;
2040 SetPortWindowPort (FRAME_MAC_WINDOW (f));
2041 LocalToGlobal (&pos);
2043 /* No selection has been chosen yet. */
2044 menu_item_choice = 0;
2045 menu_item_selection = 0;
2047 record_unwind_protect (pop_down_menu, make_save_value (f, 0));
2049 /* Add event handler so we can detect C-g. */
2050 install_menu_quit_handler (MAC_MENU_POPUP, menu);
2051 install_menu_quit_handler (MAC_MENU_POPUP_SUB, menu);
2053 /* Display the menu. */
2054 menu_item_choice = PopUpMenuSelect (menu, pos.v, pos.h, 0);
2055 menu_item_selection = LoWord (menu_item_choice);
2057 /* Get the refcon to find the correct item */
2058 if (menu_item_selection)
2060 MenuHandle sel_menu = GetMenuHandle (HiWord (menu_item_choice));
2061 if (sel_menu) {
2062 GetMenuItemRefCon (sel_menu, menu_item_selection, &refcon);
2065 else if (! for_click)
2066 /* Make "Cancel" equivalent to C-g unless this menu was popped up by
2067 a mouse press. */
2068 Fsignal (Qquit, Qnil);
2070 /* Find the selected item, and its pane, to return
2071 the proper value. */
2072 if (menu_item_selection != 0)
2074 Lisp_Object prefix, entry;
2076 prefix = entry = Qnil;
2077 i = 0;
2078 while (i < menu_items_used)
2080 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2082 subprefix_stack[submenu_depth++] = prefix;
2083 prefix = entry;
2084 i++;
2086 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2088 prefix = subprefix_stack[--submenu_depth];
2089 i++;
2091 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2093 prefix
2094 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2095 i += MENU_ITEMS_PANE_LENGTH;
2097 /* Ignore a nil in the item list.
2098 It's meaningful only for dialog boxes. */
2099 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2100 i += 1;
2101 else
2103 entry
2104 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2105 if ((int) (EMACS_INT) refcon == i)
2107 if (keymaps != 0)
2109 int j;
2111 entry = Fcons (entry, Qnil);
2112 if (!NILP (prefix))
2113 entry = Fcons (prefix, entry);
2114 for (j = submenu_depth - 1; j >= 0; j--)
2115 if (!NILP (subprefix_stack[j]))
2116 entry = Fcons (subprefix_stack[j], entry);
2118 return entry;
2120 i += MENU_ITEMS_ITEM_LENGTH;
2124 else if (!for_click)
2125 /* Make "Cancel" equivalent to C-g. */
2126 Fsignal (Qquit, Qnil);
2128 unbind_to (specpdl_count, Qnil);
2130 return Qnil;
2134 #ifdef HAVE_DIALOGS
2135 /* Construct native Mac OS menubar based on widget_value tree. */
2137 static int
2138 mac_dialog (widget_value *wv)
2140 char *dialog_name;
2141 char *prompt;
2142 char **button_labels;
2143 UInt32 *ref_cons;
2144 int nb_buttons;
2145 int left_count;
2146 int i;
2147 int dialog_width;
2148 Rect rect;
2149 WindowPtr window_ptr;
2150 ControlHandle ch;
2151 int left;
2152 EventRecord event_record;
2153 SInt16 part_code;
2154 int control_part_code;
2155 Point mouse;
2157 dialog_name = wv->name;
2158 nb_buttons = dialog_name[1] - '0';
2159 left_count = nb_buttons - (dialog_name[4] - '0');
2160 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
2161 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
2163 wv = wv->contents;
2164 prompt = (char *) alloca (strlen (wv->value) + 1);
2165 strcpy (prompt, wv->value);
2166 c2pstr (prompt);
2168 wv = wv->next;
2169 for (i = 0; i < nb_buttons; i++)
2171 button_labels[i] = wv->value;
2172 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
2173 strcpy (button_labels[i], wv->value);
2174 c2pstr (button_labels[i]);
2175 ref_cons[i] = (UInt32) wv->call_data;
2176 wv = wv->next;
2179 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
2181 SetPortWindowPort (window_ptr);
2183 TextFont (0);
2184 /* Left and right margins in the dialog are 13 pixels each.*/
2185 dialog_width = 14;
2186 /* Calculate width of dialog box: 8 pixels on each side of the text
2187 label in each button, 12 pixels between buttons. */
2188 for (i = 0; i < nb_buttons; i++)
2189 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
2191 if (left_count != 0 && nb_buttons - left_count != 0)
2192 dialog_width += 12;
2194 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
2196 SizeWindow (window_ptr, dialog_width, 78, 0);
2197 ShowWindow (window_ptr);
2199 SetPortWindowPort (window_ptr);
2201 TextFont (0);
2203 MoveTo (13, 29);
2204 DrawString (prompt);
2206 left = 13;
2207 for (i = 0; i < nb_buttons; i++)
2209 int button_width = StringWidth (button_labels[i]) + 16;
2210 SetRect (&rect, left, 45, left + button_width, 65);
2211 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2212 kControlPushButtonProc, ref_cons[i]);
2213 left += button_width + 12;
2214 if (i == left_count - 1)
2215 left += 12;
2218 i = 0;
2219 while (!i)
2221 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2222 if (event_record.what == mouseDown)
2224 part_code = FindWindow (event_record.where, &window_ptr);
2225 if (part_code == inContent)
2227 mouse = event_record.where;
2228 GlobalToLocal (&mouse);
2229 control_part_code = FindControl (mouse, window_ptr, &ch);
2230 if (control_part_code == kControlButtonPart)
2231 if (TrackControl (ch, mouse, NULL))
2232 i = GetControlReference (ch);
2237 DisposeWindow (window_ptr);
2239 return i;
2242 static char * button_names [] = {
2243 "button1", "button2", "button3", "button4", "button5",
2244 "button6", "button7", "button8", "button9", "button10" };
2246 static Lisp_Object
2247 mac_dialog_show (f, keymaps, title, header, error_name)
2248 FRAME_PTR f;
2249 int keymaps;
2250 Lisp_Object title, header;
2251 char **error_name;
2253 int i, nb_buttons=0;
2254 char dialog_name[6];
2255 int menu_item_selection;
2257 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2259 /* Number of elements seen so far, before boundary. */
2260 int left_count = 0;
2261 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2262 int boundary_seen = 0;
2264 *error_name = NULL;
2266 if (menu_items_n_panes > 1)
2268 *error_name = "Multiple panes in dialog box";
2269 return Qnil;
2272 /* Create a tree of widget_value objects
2273 representing the text label and buttons. */
2275 Lisp_Object pane_name, prefix;
2276 char *pane_string;
2277 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2278 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2279 pane_string = (NILP (pane_name)
2280 ? "" : (char *) SDATA (pane_name));
2281 prev_wv = xmalloc_widget_value ();
2282 prev_wv->value = pane_string;
2283 if (keymaps && !NILP (prefix))
2284 prev_wv->name++;
2285 prev_wv->enabled = 1;
2286 prev_wv->name = "message";
2287 prev_wv->help = Qnil;
2288 first_wv = prev_wv;
2290 /* Loop over all panes and items, filling in the tree. */
2291 i = MENU_ITEMS_PANE_LENGTH;
2292 while (i < menu_items_used)
2295 /* Create a new item within current pane. */
2296 Lisp_Object item_name, enable, descrip;
2297 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2298 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2299 descrip
2300 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2302 if (NILP (item_name))
2304 free_menubar_widget_value_tree (first_wv);
2305 *error_name = "Submenu in dialog items";
2306 return Qnil;
2308 if (EQ (item_name, Qquote))
2310 /* This is the boundary between left-side elts
2311 and right-side elts. Stop incrementing right_count. */
2312 boundary_seen = 1;
2313 i++;
2314 continue;
2316 if (nb_buttons >= 9)
2318 free_menubar_widget_value_tree (first_wv);
2319 *error_name = "Too many dialog items";
2320 return Qnil;
2323 wv = xmalloc_widget_value ();
2324 prev_wv->next = wv;
2325 wv->name = (char *) button_names[nb_buttons];
2326 if (!NILP (descrip))
2327 wv->key = (char *) SDATA (descrip);
2328 wv->value = (char *) SDATA (item_name);
2329 wv->call_data = (void *) i;
2330 /* menu item is identified by its index in menu_items table */
2331 wv->enabled = !NILP (enable);
2332 wv->help = Qnil;
2333 prev_wv = wv;
2335 if (! boundary_seen)
2336 left_count++;
2338 nb_buttons++;
2339 i += MENU_ITEMS_ITEM_LENGTH;
2342 /* If the boundary was not specified,
2343 by default put half on the left and half on the right. */
2344 if (! boundary_seen)
2345 left_count = nb_buttons - nb_buttons / 2;
2347 wv = xmalloc_widget_value ();
2348 wv->name = dialog_name;
2349 wv->help = Qnil;
2351 /* Frame title: 'Q' = Question, 'I' = Information.
2352 Can also have 'E' = Error if, one day, we want
2353 a popup for errors. */
2354 if (NILP(header))
2355 dialog_name[0] = 'Q';
2356 else
2357 dialog_name[0] = 'I';
2359 /* Dialog boxes use a really stupid name encoding
2360 which specifies how many buttons to use
2361 and how many buttons are on the right. */
2362 dialog_name[1] = '0' + nb_buttons;
2363 dialog_name[2] = 'B';
2364 dialog_name[3] = 'R';
2365 /* Number of buttons to put on the right. */
2366 dialog_name[4] = '0' + nb_buttons - left_count;
2367 dialog_name[5] = 0;
2368 wv->contents = first_wv;
2369 first_wv = wv;
2372 /* Actually create the dialog. */
2373 #ifdef HAVE_DIALOGS
2374 menu_item_selection = mac_dialog (first_wv);
2375 #else
2376 menu_item_selection = 0;
2377 #endif
2379 /* Free the widget_value objects we used to specify the contents. */
2380 free_menubar_widget_value_tree (first_wv);
2382 /* Find the selected item, and its pane, to return
2383 the proper value. */
2384 if (menu_item_selection != 0)
2386 Lisp_Object prefix;
2388 prefix = Qnil;
2389 i = 0;
2390 while (i < menu_items_used)
2392 Lisp_Object entry;
2394 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2396 prefix
2397 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2398 i += MENU_ITEMS_PANE_LENGTH;
2400 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2402 /* This is the boundary between left-side elts and
2403 right-side elts. */
2404 ++i;
2406 else
2408 entry
2409 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2410 if (menu_item_selection == i)
2412 if (keymaps != 0)
2414 entry = Fcons (entry, Qnil);
2415 if (!NILP (prefix))
2416 entry = Fcons (prefix, entry);
2418 return entry;
2420 i += MENU_ITEMS_ITEM_LENGTH;
2424 else
2425 /* Make "Cancel" equivalent to C-g. */
2426 Fsignal (Qquit, Qnil);
2428 return Qnil;
2430 #endif /* HAVE_DIALOGS */
2433 /* Is this item a separator? */
2434 static int
2435 name_is_separator (name)
2436 const char *name;
2438 const char *start = name;
2440 /* Check if name string consists of only dashes ('-'). */
2441 while (*name == '-') name++;
2442 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2443 or "--deep-shadow". We don't implement them yet, se we just treat
2444 them like normal separators. */
2445 return (*name == '\0' || start + 2 == name);
2448 static void
2449 add_menu_item (menu, pos, wv)
2450 MenuHandle menu;
2451 int pos;
2452 widget_value *wv;
2454 #if TARGET_API_MAC_CARBON
2455 CFStringRef item_name;
2456 #else
2457 Str255 item_name;
2458 #endif
2460 if (name_is_separator (wv->name))
2461 AppendMenu (menu, "\p-");
2462 else
2464 AppendMenu (menu, "\pX");
2466 #if TARGET_API_MAC_CARBON
2467 item_name = cfstring_create_with_utf8_cstring (wv->name);
2469 if (wv->key != NULL)
2471 CFStringRef name, key;
2473 name = item_name;
2474 key = cfstring_create_with_utf8_cstring (wv->key);
2475 item_name = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@ %@"),
2476 name, key);
2477 CFRelease (name);
2478 CFRelease (key);
2481 SetMenuItemTextWithCFString (menu, pos, item_name);
2482 CFRelease (item_name);
2484 if (wv->enabled)
2485 EnableMenuItem (menu, pos);
2486 else
2487 DisableMenuItem (menu, pos);
2488 #else /* ! TARGET_API_MAC_CARBON */
2489 item_name[sizeof (item_name) - 1] = '\0';
2490 strncpy (item_name, wv->name, sizeof (item_name) - 1);
2491 if (wv->key != NULL)
2493 int len = strlen (item_name);
2495 strncpy (item_name + len, " ", sizeof (item_name) - 1 - len);
2496 len = strlen (item_name);
2497 strncpy (item_name + len, wv->key, sizeof (item_name) - 1 - len);
2499 c2pstr (item_name);
2500 SetMenuItemText (menu, pos, item_name);
2502 if (wv->enabled)
2503 EnableItem (menu, pos);
2504 else
2505 DisableItem (menu, pos);
2506 #endif /* ! TARGET_API_MAC_CARBON */
2508 /* Draw radio buttons and tickboxes. */
2509 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2510 wv->button_type == BUTTON_TYPE_RADIO))
2511 SetItemMark (menu, pos, checkMark);
2512 else
2513 SetItemMark (menu, pos, noMark);
2515 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
2519 /* Construct native Mac OS menu based on widget_value tree. */
2521 static int
2522 fill_menu (menu, wv, kind, submenu_id)
2523 MenuHandle menu;
2524 widget_value *wv;
2525 enum mac_menu_kind kind;
2526 int submenu_id;
2528 int pos;
2530 for (pos = 1; wv != NULL; wv = wv->next, pos++)
2532 add_menu_item (menu, pos, wv);
2533 if (wv->contents && submenu_id < min_menu_id[kind + 1])
2535 MenuHandle submenu = NewMenu (submenu_id, "\pX");
2537 InsertMenu (submenu, -1);
2538 SetMenuItemHierarchicalID (menu, pos, submenu_id);
2539 submenu_id = fill_menu (submenu, wv->contents, kind, submenu_id + 1);
2543 return submenu_id;
2546 /* Construct native Mac OS menubar based on widget_value tree. */
2548 static void
2549 fill_menubar (wv, deep_p)
2550 widget_value *wv;
2551 int deep_p;
2553 int id, submenu_id;
2554 MenuHandle menu;
2555 Str255 title;
2556 #if !TARGET_API_MAC_CARBON
2557 int title_changed_p = 0;
2558 #endif
2560 /* Clean up the menu bar when filled by the entire menu trees. */
2561 if (deep_p)
2563 dispose_menus (MAC_MENU_MENU_BAR, 0);
2564 dispose_menus (MAC_MENU_MENU_BAR_SUB, 0);
2565 #if !TARGET_API_MAC_CARBON
2566 title_changed_p = 1;
2567 #endif
2570 /* Fill menu bar titles and submenus. Reuse the existing menu bar
2571 titles as much as possible to minimize redraw (if !deep_p). */
2572 submenu_id = min_menu_id[MAC_MENU_MENU_BAR_SUB];
2573 for (id = min_menu_id[MAC_MENU_MENU_BAR];
2574 wv != NULL && id < min_menu_id[MAC_MENU_MENU_BAR + 1];
2575 wv = wv->next, id++)
2577 strncpy (title, wv->name, 255);
2578 title[255] = '\0';
2579 c2pstr (title);
2581 menu = GetMenuHandle (id);
2582 if (menu)
2584 #if TARGET_API_MAC_CARBON
2585 Str255 old_title;
2587 GetMenuTitle (menu, old_title);
2588 if (!EqualString (title, old_title, false, false))
2589 SetMenuTitle (menu, title);
2590 #else /* !TARGET_API_MAC_CARBON */
2591 if (!EqualString (title, (*menu)->menuData, false, false))
2593 DeleteMenu (id);
2594 DisposeMenu (menu);
2595 menu = NewMenu (id, title);
2596 InsertMenu (menu, GetMenuHandle (id + 1) ? id + 1 : 0);
2597 title_changed_p = 1;
2599 #endif /* !TARGET_API_MAC_CARBON */
2601 else
2603 menu = NewMenu (id, title);
2604 InsertMenu (menu, 0);
2605 #if !TARGET_API_MAC_CARBON
2606 title_changed_p = 1;
2607 #endif
2610 if (wv->contents)
2611 submenu_id = fill_menu (menu, wv->contents, MAC_MENU_MENU_BAR_SUB,
2612 submenu_id);
2615 if (id < min_menu_id[MAC_MENU_MENU_BAR + 1] && GetMenuHandle (id))
2617 dispose_menus (MAC_MENU_MENU_BAR, id);
2618 #if !TARGET_API_MAC_CARBON
2619 title_changed_p = 1;
2620 #endif
2623 #if !TARGET_API_MAC_CARBON
2624 if (title_changed_p)
2625 InvalMenuBar ();
2626 #endif
2629 /* Dispose of menus that belong to KIND, and remove them from the menu
2630 list. ID is the lower bound of menu IDs that will be processed. */
2632 static void
2633 dispose_menus (kind, id)
2634 enum mac_menu_kind kind;
2635 int id;
2637 for (id = max (id, min_menu_id[kind]); id < min_menu_id[kind + 1]; id++)
2639 MenuHandle menu = GetMenuHandle (id);
2641 if (menu == NULL)
2642 break;
2643 DeleteMenu (id);
2644 DisposeMenu (menu);
2648 #endif /* HAVE_MENUS */
2650 /* The following is used by delayed window autoselection. */
2652 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2653 doc: /* Return t if a menu or popup dialog is active. */)
2656 /* Always return Qnil since menu selection functions do not return
2657 until a selection has been made or cancelled. */
2658 return Qnil;
2661 void
2662 syms_of_macmenu ()
2664 staticpro (&menu_items);
2665 menu_items = Qnil;
2667 Qdebug_on_next_call = intern ("debug-on-next-call");
2668 staticpro (&Qdebug_on_next_call);
2670 defsubr (&Sx_popup_menu);
2671 defsubr (&Smenu_or_popup_active_p);
2672 #ifdef HAVE_MENUS
2673 defsubr (&Sx_popup_dialog);
2674 #endif
2677 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2678 (do not change this comment) */