(Version, mh-version): Update for release 7.92.
[emacs/old-mirror.git] / src / macmenu.c
blobbd4ad6291cf21c37e461175c3838f9ad452d5481
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 #define POPUP_SUBMENU_ID 235
66 #define MIN_POPUP_SUBMENU_ID 512
67 #define MIN_MENU_ID 256
68 #define MIN_SUBMENU_ID 1
70 #define DIALOG_WINDOW_RESOURCE 130
72 #define HAVE_DIALOGS 1
74 #undef HAVE_MULTILINGUAL_MENU
75 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
77 /******************************************************************/
78 /* Definitions copied from lwlib.h */
80 typedef void * XtPointer;
82 enum button_type
84 BUTTON_TYPE_NONE,
85 BUTTON_TYPE_TOGGLE,
86 BUTTON_TYPE_RADIO
89 /* This structure is based on the one in ../lwlib/lwlib.h, modified
90 for Mac OS. */
91 typedef struct _widget_value
93 /* name of widget */
94 Lisp_Object lname;
95 char* name;
96 /* value (meaning depend on widget type) */
97 char* value;
98 /* keyboard equivalent. no implications for XtTranslations */
99 Lisp_Object lkey;
100 char* key;
101 /* Help string or nil if none.
102 GC finds this string through the frame's menu_bar_vector
103 or through menu_items. */
104 Lisp_Object help;
105 /* true if enabled */
106 Boolean enabled;
107 /* true if selected */
108 Boolean selected;
109 /* The type of a button. */
110 enum button_type button_type;
111 /* true if menu title */
112 Boolean title;
113 #if 0
114 /* true if was edited (maintained by get_value) */
115 Boolean edited;
116 /* true if has changed (maintained by lw library) */
117 change_type change;
118 /* true if this widget itself has changed,
119 but not counting the other widgets found in the `next' field. */
120 change_type this_one_change;
121 #endif
122 /* Contents of the sub-widgets, also selected slot for checkbox */
123 struct _widget_value* contents;
124 /* data passed to callback */
125 XtPointer call_data;
126 /* next one in the list */
127 struct _widget_value* next;
128 #if 0
129 /* slot for the toolkit dependent part. Always initialize to NULL. */
130 void* toolkit_data;
131 /* tell us if we should free the toolkit data slot when freeing the
132 widget_value itself. */
133 Boolean free_toolkit_data;
135 /* we resource the widget_value structures; this points to the next
136 one on the free list if this one has been deallocated.
138 struct _widget_value *free_list;
139 #endif
140 } widget_value;
142 /* Assumed by other routines to zero area returned. */
143 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
144 0, (sizeof (widget_value)))
145 #define free_widget_value(wv) xfree (wv)
147 /******************************************************************/
149 #ifndef TRUE
150 #define TRUE 1
151 #define FALSE 0
152 #endif /* no TRUE */
154 Lisp_Object Vmenu_updating_frame;
156 Lisp_Object Qdebug_on_next_call;
158 extern Lisp_Object Qmenu_bar, Qmac_apple_event;
160 extern Lisp_Object QCtoggle, QCradio;
162 extern Lisp_Object Voverriding_local_map;
163 extern Lisp_Object Voverriding_local_map_menu_flag;
165 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
167 extern Lisp_Object Qmenu_bar_update_hook;
169 void set_frame_menubar P_ ((FRAME_PTR, int, int));
171 #if TARGET_API_MAC_CARBON
172 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
173 #else
174 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
175 #endif
177 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
178 Lisp_Object, Lisp_Object, Lisp_Object,
179 Lisp_Object, Lisp_Object));
180 #ifdef HAVE_DIALOGS
181 static Lisp_Object mac_dialog_show P_ ((FRAME_PTR, int, Lisp_Object,
182 Lisp_Object, char **));
183 #endif
184 static Lisp_Object mac_menu_show P_ ((struct frame *, int, int, int, int,
185 Lisp_Object, char **));
186 static void keymap_panes P_ ((Lisp_Object *, int, int));
187 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
188 int, int));
189 static void list_of_panes P_ ((Lisp_Object));
190 static void list_of_items P_ ((Lisp_Object));
192 static void fill_submenu (MenuHandle, widget_value *);
193 static void fill_menubar (widget_value *);
196 /* This holds a Lisp vector that holds the results of decoding
197 the keymaps or alist-of-alists that specify a menu.
199 It describes the panes and items within the panes.
201 Each pane is described by 3 elements in the vector:
202 t, the pane name, the pane's prefix key.
203 Then follow the pane's items, with 5 elements per item:
204 the item string, the enable flag, the item's value,
205 the definition, and the equivalent keyboard key's description string.
207 In some cases, multiple levels of menus may be described.
208 A single vector slot containing nil indicates the start of a submenu.
209 A single vector slot containing lambda indicates the end of a submenu.
210 The submenu follows a menu item which is the way to reach the submenu.
212 A single vector slot containing quote indicates that the
213 following items should appear on the right of a dialog box.
215 Using a Lisp vector to hold this information while we decode it
216 takes care of protecting all the data from GC. */
218 #define MENU_ITEMS_PANE_NAME 1
219 #define MENU_ITEMS_PANE_PREFIX 2
220 #define MENU_ITEMS_PANE_LENGTH 3
222 enum menu_item_idx
224 MENU_ITEMS_ITEM_NAME = 0,
225 MENU_ITEMS_ITEM_ENABLE,
226 MENU_ITEMS_ITEM_VALUE,
227 MENU_ITEMS_ITEM_EQUIV_KEY,
228 MENU_ITEMS_ITEM_DEFINITION,
229 MENU_ITEMS_ITEM_TYPE,
230 MENU_ITEMS_ITEM_SELECTED,
231 MENU_ITEMS_ITEM_HELP,
232 MENU_ITEMS_ITEM_LENGTH
235 static Lisp_Object menu_items;
237 /* Number of slots currently allocated in menu_items. */
238 static int menu_items_allocated;
240 /* This is the index in menu_items of the first empty slot. */
241 static int menu_items_used;
243 /* The number of panes currently recorded in menu_items,
244 excluding those within submenus. */
245 static int menu_items_n_panes;
247 /* Current depth within submenus. */
248 static int menu_items_submenu_depth;
250 /* Flag which when set indicates a dialog or menu has been posted by
251 Xt on behalf of one of the widget sets. */
252 static int popup_activated_flag;
254 /* Index of the next submenu */
255 static int submenu_id;
257 static int next_menubar_widget_id;
259 /* This is set nonzero after the user activates the menu bar, and set
260 to zero again after the menu bars are redisplayed by prepare_menu_bar.
261 While it is nonzero, all calls to set_frame_menubar go deep.
263 I don't understand why this is needed, but it does seem to be
264 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
266 int pending_menu_activation;
268 /* Initialize the menu_items structure if we haven't already done so.
269 Also mark it as currently empty. */
271 static void
272 init_menu_items ()
274 if (NILP (menu_items))
276 menu_items_allocated = 60;
277 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
280 menu_items_used = 0;
281 menu_items_n_panes = 0;
282 menu_items_submenu_depth = 0;
285 /* Call at the end of generating the data in menu_items. */
287 static void
288 finish_menu_items ()
292 /* Call when finished using the data for the current menu
293 in menu_items. */
295 static void
296 discard_menu_items ()
298 /* Free the structure if it is especially large.
299 Otherwise, hold on to it, to save time. */
300 if (menu_items_allocated > 200)
302 menu_items = Qnil;
303 menu_items_allocated = 0;
307 /* Make the menu_items vector twice as large. */
309 static void
310 grow_menu_items ()
312 Lisp_Object old;
313 int old_size = menu_items_allocated;
314 old = menu_items;
316 menu_items_allocated *= 2;
317 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
318 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
319 old_size * sizeof (Lisp_Object));
322 /* Begin a submenu. */
324 static void
325 push_submenu_start ()
327 if (menu_items_used + 1 > menu_items_allocated)
328 grow_menu_items ();
330 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
331 menu_items_submenu_depth++;
334 /* End a submenu. */
336 static void
337 push_submenu_end ()
339 if (menu_items_used + 1 > menu_items_allocated)
340 grow_menu_items ();
342 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
343 menu_items_submenu_depth--;
346 /* Indicate boundary between left and right. */
348 static void
349 push_left_right_boundary ()
351 if (menu_items_used + 1 > menu_items_allocated)
352 grow_menu_items ();
354 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
357 /* Start a new menu pane in menu_items.
358 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
360 static void
361 push_menu_pane (name, prefix_vec)
362 Lisp_Object name, prefix_vec;
364 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
365 grow_menu_items ();
367 if (menu_items_submenu_depth == 0)
368 menu_items_n_panes++;
369 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
370 XVECTOR (menu_items)->contents[menu_items_used++] = name;
371 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
374 /* Push one menu item into the current pane. NAME is the string to
375 display. ENABLE if non-nil means this item can be selected. KEY
376 is the key generated by choosing this item, or nil if this item
377 doesn't really have a definition. DEF is the definition of this
378 item. EQUIV is the textual description of the keyboard equivalent
379 for this item (or nil if none). TYPE is the type of this menu
380 item, one of nil, `toggle' or `radio'. */
382 static void
383 push_menu_item (name, enable, key, def, equiv, type, selected, help)
384 Lisp_Object name, enable, key, def, equiv, type, selected, help;
386 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
387 grow_menu_items ();
389 XVECTOR (menu_items)->contents[menu_items_used++] = name;
390 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
391 XVECTOR (menu_items)->contents[menu_items_used++] = key;
392 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
393 XVECTOR (menu_items)->contents[menu_items_used++] = def;
394 XVECTOR (menu_items)->contents[menu_items_used++] = type;
395 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
396 XVECTOR (menu_items)->contents[menu_items_used++] = help;
399 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
400 and generate menu panes for them in menu_items.
401 If NOTREAL is nonzero,
402 don't bother really computing whether an item is enabled. */
404 static void
405 keymap_panes (keymaps, nmaps, notreal)
406 Lisp_Object *keymaps;
407 int nmaps;
408 int notreal;
410 int mapno;
412 init_menu_items ();
414 /* Loop over the given keymaps, making a pane for each map.
415 But don't make a pane that is empty--ignore that map instead.
416 P is the number of panes we have made so far. */
417 for (mapno = 0; mapno < nmaps; mapno++)
418 single_keymap_panes (keymaps[mapno],
419 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
421 finish_menu_items ();
424 /* Args passed between single_keymap_panes and single_menu_item. */
425 struct skp
427 Lisp_Object pending_maps;
428 int maxdepth, notreal;
431 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
432 void *));
434 /* This is a recursive subroutine of keymap_panes.
435 It handles one keymap, KEYMAP.
436 The other arguments are passed along
437 or point to local variables of the previous function.
438 If NOTREAL is nonzero, only check for equivalent key bindings, don't
439 evaluate expressions in menu items and don't make any menu.
441 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
443 static void
444 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
445 Lisp_Object keymap;
446 Lisp_Object pane_name;
447 Lisp_Object prefix;
448 int notreal;
449 int maxdepth;
451 struct skp skp;
452 struct gcpro gcpro1;
454 skp.pending_maps = Qnil;
455 skp.maxdepth = maxdepth;
456 skp.notreal = notreal;
458 if (maxdepth <= 0)
459 return;
461 push_menu_pane (pane_name, prefix);
463 GCPRO1 (skp.pending_maps);
464 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
465 UNGCPRO;
467 /* Process now any submenus which want to be panes at this level. */
468 while (CONSP (skp.pending_maps))
470 Lisp_Object elt, eltcdr, string;
471 elt = XCAR (skp.pending_maps);
472 eltcdr = XCDR (elt);
473 string = XCAR (eltcdr);
474 /* We no longer discard the @ from the beginning of the string here.
475 Instead, we do this in mac_menu_show. */
476 single_keymap_panes (Fcar (elt), string,
477 XCDR (eltcdr), notreal, maxdepth - 1);
478 skp.pending_maps = XCDR (skp.pending_maps);
482 /* This is a subroutine of single_keymap_panes that handles one
483 keymap entry.
484 KEY is a key in a keymap and ITEM is its binding.
485 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
486 separate panes.
487 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
488 evaluate expressions in menu items and don't make any menu.
489 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
491 static void
492 single_menu_item (key, item, dummy, skp_v)
493 Lisp_Object key, item, dummy;
494 void *skp_v;
496 Lisp_Object map, item_string, enabled;
497 struct gcpro gcpro1, gcpro2;
498 int res;
499 struct skp *skp = skp_v;
501 /* Parse the menu item and leave the result in item_properties. */
502 GCPRO2 (key, item);
503 res = parse_menu_item (item, skp->notreal, 0);
504 UNGCPRO;
505 if (!res)
506 return; /* Not a menu item. */
508 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
510 if (skp->notreal)
512 /* We don't want to make a menu, just traverse the keymaps to
513 precompute equivalent key bindings. */
514 if (!NILP (map))
515 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
516 return;
519 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
520 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
522 if (!NILP (map) && SREF (item_string, 0) == '@')
524 if (!NILP (enabled))
525 /* An enabled separate pane. Remember this to handle it later. */
526 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
527 skp->pending_maps);
528 return;
531 push_menu_item (item_string, enabled, key,
532 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
533 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
534 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
535 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
536 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
538 /* Display a submenu using the toolkit. */
539 if (! (NILP (map) || NILP (enabled)))
541 push_submenu_start ();
542 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
543 push_submenu_end ();
547 /* Push all the panes and items of a menu described by the
548 alist-of-alists MENU.
549 This handles old-fashioned calls to x-popup-menu. */
551 static void
552 list_of_panes (menu)
553 Lisp_Object menu;
555 Lisp_Object tail;
557 init_menu_items ();
559 for (tail = menu; CONSP (tail); tail = XCDR (tail))
561 Lisp_Object elt, pane_name, pane_data;
562 elt = XCAR (tail);
563 pane_name = Fcar (elt);
564 CHECK_STRING (pane_name);
565 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
566 pane_data = Fcdr (elt);
567 CHECK_CONS (pane_data);
568 list_of_items (pane_data);
571 finish_menu_items ();
574 /* Push the items in a single pane defined by the alist PANE. */
576 static void
577 list_of_items (pane)
578 Lisp_Object pane;
580 Lisp_Object tail, item, item1;
582 for (tail = pane; CONSP (tail); tail = XCDR (tail))
584 item = XCAR (tail);
585 if (STRINGP (item))
586 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
587 Qnil, Qnil, Qnil, Qnil);
588 else if (CONSP (item))
590 item1 = XCAR (item);
591 CHECK_STRING (item1);
592 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
593 Qt, Qnil, Qnil, Qnil, Qnil);
595 else
596 push_left_right_boundary ();
601 static Lisp_Object
602 cleanup_popup_menu (arg)
603 Lisp_Object arg;
605 discard_menu_items ();
608 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
609 doc: /* Pop up a deck-of-cards menu and return user's selection.
610 POSITION is a position specification. This is either a mouse button event
611 or a list ((XOFFSET YOFFSET) WINDOW)
612 where XOFFSET and YOFFSET are positions in pixels from the top left
613 corner of WINDOW. (WINDOW may be a window or a frame object.)
614 This controls the position of the top left of the menu as a whole.
615 If POSITION is t, it means to use the current mouse position.
617 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
618 The menu items come from key bindings that have a menu string as well as
619 a definition; actually, the "definition" in such a key binding looks like
620 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
621 the keymap as a top-level element.
623 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
624 Otherwise, REAL-DEFINITION should be a valid key binding definition.
626 You can also use a list of keymaps as MENU.
627 Then each keymap makes a separate pane.
629 When MENU is a keymap or a list of keymaps, the return value is the
630 list of events corresponding to the user's choice. Note that
631 `x-popup-menu' does not actually execute the command bound to that
632 sequence of events.
634 Alternatively, you can specify a menu of multiple panes
635 with a list of the form (TITLE PANE1 PANE2...),
636 where each pane is a list of form (TITLE ITEM1 ITEM2...).
637 Each ITEM is normally a cons cell (STRING . VALUE);
638 but a string can appear as an item--that makes a nonselectable line
639 in the menu.
640 With this form of menu, the return value is VALUE from the chosen item.
642 If POSITION is nil, don't display the menu at all, just precalculate the
643 cached information about equivalent key sequences.
645 If the user gets rid of the menu without making a valid choice, for
646 instance by clicking the mouse away from a valid choice or by typing
647 keyboard input, then this normally results in a quit and
648 `x-popup-menu' does not return. But if POSITION is a mouse button
649 event (indicating that the user invoked the menu with the mouse) then
650 no quit occurs and `x-popup-menu' returns nil. */)
651 (position, menu)
652 Lisp_Object position, menu;
654 Lisp_Object keymap, tem;
655 int xpos = 0, ypos = 0;
656 Lisp_Object title;
657 char *error_name = NULL;
658 Lisp_Object selection;
659 FRAME_PTR f = NULL;
660 Lisp_Object x, y, window;
661 int keymaps = 0;
662 int for_click = 0;
663 int specpdl_count = SPECPDL_INDEX ();
664 struct gcpro gcpro1;
666 #ifdef HAVE_MENUS
667 if (! NILP (position))
669 check_mac ();
671 /* Decode the first argument: find the window and the coordinates. */
672 if (EQ (position, Qt)
673 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
674 || EQ (XCAR (position), Qtool_bar)
675 || EQ (XCAR (position), Qmac_apple_event))))
677 /* Use the mouse's current position. */
678 FRAME_PTR new_f = SELECTED_FRAME ();
679 Lisp_Object bar_window;
680 enum scroll_bar_part part;
681 unsigned long time;
683 if (mouse_position_hook)
684 (*mouse_position_hook) (&new_f, 1, &bar_window,
685 &part, &x, &y, &time);
686 if (new_f != 0)
687 XSETFRAME (window, new_f);
688 else
690 window = selected_window;
691 XSETFASTINT (x, 0);
692 XSETFASTINT (y, 0);
695 else
697 tem = Fcar (position);
698 if (CONSP (tem))
700 window = Fcar (Fcdr (position));
701 x = XCAR (tem);
702 y = Fcar (XCDR (tem));
704 else
706 for_click = 1;
707 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
708 window = Fcar (tem); /* POSN_WINDOW (tem) */
709 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
710 x = Fcar (tem);
711 y = Fcdr (tem);
715 CHECK_NUMBER (x);
716 CHECK_NUMBER (y);
718 /* Decode where to put the menu. */
720 if (FRAMEP (window))
722 f = XFRAME (window);
723 xpos = 0;
724 ypos = 0;
726 else if (WINDOWP (window))
728 CHECK_LIVE_WINDOW (window);
729 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
731 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
732 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
734 else
735 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
736 but I don't want to make one now. */
737 CHECK_WINDOW (window);
739 xpos += XINT (x);
740 ypos += XINT (y);
742 XSETFRAME (Vmenu_updating_frame, f);
744 else
745 Vmenu_updating_frame = Qnil;
746 #endif /* HAVE_MENUS */
748 title = Qnil;
749 GCPRO1 (title);
751 /* Decode the menu items from what was specified. */
753 keymap = get_keymap (menu, 0, 0);
754 if (CONSP (keymap))
756 /* We were given a keymap. Extract menu info from the keymap. */
757 Lisp_Object prompt;
759 /* Extract the detailed info to make one pane. */
760 keymap_panes (&menu, 1, NILP (position));
762 /* Search for a string appearing directly as an element of the keymap.
763 That string is the title of the menu. */
764 prompt = Fkeymap_prompt (keymap);
765 if (NILP (title) && !NILP (prompt))
766 title = prompt;
768 /* Make that be the pane title of the first pane. */
769 if (!NILP (prompt) && menu_items_n_panes >= 0)
770 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
772 keymaps = 1;
774 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
776 /* We were given a list of keymaps. */
777 int nmaps = XFASTINT (Flength (menu));
778 Lisp_Object *maps
779 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
780 int i;
782 title = Qnil;
784 /* The first keymap that has a prompt string
785 supplies the menu title. */
786 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
788 Lisp_Object prompt;
790 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
792 prompt = Fkeymap_prompt (keymap);
793 if (NILP (title) && !NILP (prompt))
794 title = prompt;
797 /* Extract the detailed info to make one pane. */
798 keymap_panes (maps, nmaps, NILP (position));
800 /* Make the title be the pane title of the first pane. */
801 if (!NILP (title) && menu_items_n_panes >= 0)
802 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
804 keymaps = 1;
806 else
808 /* We were given an old-fashioned menu. */
809 title = Fcar (menu);
810 CHECK_STRING (title);
812 list_of_panes (Fcdr (menu));
814 keymaps = 0;
817 if (NILP (position))
819 discard_menu_items ();
820 UNGCPRO;
821 return Qnil;
824 #ifdef HAVE_MENUS
825 /* Display them in a menu. */
826 record_unwind_protect (cleanup_popup_menu, Qnil);
827 BLOCK_INPUT;
829 selection = mac_menu_show (f, xpos, ypos, for_click,
830 keymaps, title, &error_name);
831 UNBLOCK_INPUT;
832 unbind_to (specpdl_count, Qnil);
834 UNGCPRO;
835 #endif /* HAVE_MENUS */
837 if (error_name) error (error_name);
838 return selection;
841 #ifdef HAVE_MENUS
843 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
844 doc: /* Pop up a dialog box and return user's selection.
845 POSITION specifies which frame to use.
846 This is normally a mouse button event or a window or frame.
847 If POSITION is t, it means to use the frame the mouse is on.
848 The dialog box appears in the middle of the specified frame.
850 CONTENTS specifies the alternatives to display in the dialog box.
851 It is a list of the form (DIALOG ITEM1 ITEM2...).
852 Each ITEM is a cons cell (STRING . VALUE).
853 The return value is VALUE from the chosen item.
855 An ITEM may also be just a string--that makes a nonselectable item.
856 An ITEM may also be nil--that means to put all preceding items
857 on the left of the dialog box and all following items on the right.
858 \(By default, approximately half appear on each side.)
860 If HEADER is non-nil, the frame title for the box is "Information",
861 otherwise it is "Question".
863 If the user gets rid of the dialog box without making a valid choice,
864 for instance using the window manager, then this produces a quit and
865 `x-popup-dialog' does not return. */)
866 (position, contents, header)
867 Lisp_Object position, contents, header;
869 FRAME_PTR f = NULL;
870 Lisp_Object window;
872 check_mac ();
874 /* Decode the first argument: find the window or frame to use. */
875 if (EQ (position, Qt)
876 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
877 || EQ (XCAR (position), Qtool_bar)
878 || EQ (XCAR (position), Qmac_apple_event))))
880 #if 0 /* Using the frame the mouse is on may not be right. */
881 /* Use the mouse's current position. */
882 FRAME_PTR new_f = SELECTED_FRAME ();
883 Lisp_Object bar_window;
884 enum scroll_bar_part part;
885 unsigned long time;
886 Lisp_Object x, y;
888 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
890 if (new_f != 0)
891 XSETFRAME (window, new_f);
892 else
893 window = selected_window;
894 #endif
895 window = selected_window;
897 else if (CONSP (position))
899 Lisp_Object tem;
900 tem = Fcar (position);
901 if (CONSP (tem))
902 window = Fcar (Fcdr (position));
903 else
905 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
906 window = Fcar (tem); /* POSN_WINDOW (tem) */
909 else if (WINDOWP (position) || FRAMEP (position))
910 window = position;
911 else
912 window = Qnil;
914 /* Decode where to put the menu. */
916 if (FRAMEP (window))
917 f = XFRAME (window);
918 else if (WINDOWP (window))
920 CHECK_LIVE_WINDOW (window);
921 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
923 else
924 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
925 but I don't want to make one now. */
926 CHECK_WINDOW (window);
928 #ifndef HAVE_DIALOGS
929 /* Display a menu with these alternatives
930 in the middle of frame F. */
932 Lisp_Object x, y, frame, newpos;
933 XSETFRAME (frame, f);
934 XSETINT (x, x_pixel_width (f) / 2);
935 XSETINT (y, x_pixel_height (f) / 2);
936 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
938 return Fx_popup_menu (newpos,
939 Fcons (Fcar (contents), Fcons (contents, Qnil)));
941 #else /* HAVE_DIALOGS */
943 Lisp_Object title;
944 char *error_name;
945 Lisp_Object selection;
946 int specpdl_count = SPECPDL_INDEX ();
948 /* Decode the dialog items from what was specified. */
949 title = Fcar (contents);
950 CHECK_STRING (title);
952 list_of_panes (Fcons (contents, Qnil));
954 /* Display them in a dialog box. */
955 record_unwind_protect (cleanup_popup_menu, Qnil);
956 BLOCK_INPUT;
957 selection = mac_dialog_show (f, 0, title, header, &error_name);
958 UNBLOCK_INPUT;
959 unbind_to (specpdl_count, Qnil);
961 if (error_name) error (error_name);
962 return selection;
964 #endif /* HAVE_DIALOGS */
967 /* Activate the menu bar of frame F.
968 This is called from keyboard.c when it gets the
969 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
971 To activate the menu bar, we use the button-press event location
972 that was saved in saved_menu_event_location.
974 But first we recompute the menu bar contents (the whole tree).
976 The reason for saving the button event until here, instead of
977 passing it to the toolkit right away, is that we can safely
978 execute Lisp code. */
980 void
981 x_activate_menubar (f)
982 FRAME_PTR f;
984 SInt32 menu_choice;
985 extern Point saved_menu_event_location;
987 set_frame_menubar (f, 0, 1);
988 BLOCK_INPUT;
990 menu_choice = MenuSelect (saved_menu_event_location);
991 do_menu_choice (menu_choice);
993 UNBLOCK_INPUT;
996 /* This callback is called from the menu bar pulldown menu
997 when the user makes a selection.
998 Figure out what the user chose
999 and put the appropriate events into the keyboard buffer. */
1001 void
1002 menubar_selection_callback (FRAME_PTR f, int client_data)
1004 Lisp_Object prefix, entry;
1005 Lisp_Object vector;
1006 Lisp_Object *subprefix_stack;
1007 int submenu_depth = 0;
1008 int i;
1010 if (!f)
1011 return;
1012 entry = Qnil;
1013 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1014 vector = f->menu_bar_vector;
1015 prefix = Qnil;
1016 i = 0;
1017 while (i < f->menu_bar_items_used)
1019 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1021 subprefix_stack[submenu_depth++] = prefix;
1022 prefix = entry;
1023 i++;
1025 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1027 prefix = subprefix_stack[--submenu_depth];
1028 i++;
1030 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1032 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1033 i += MENU_ITEMS_PANE_LENGTH;
1035 else
1037 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1038 /* The EMACS_INT cast avoids a warning. There's no problem
1039 as long as pointers have enough bits to hold small integers. */
1040 if ((int) (EMACS_INT) client_data == i)
1042 int j;
1043 struct input_event buf;
1044 Lisp_Object frame;
1045 EVENT_INIT (buf);
1047 XSETFRAME (frame, f);
1048 buf.kind = MENU_BAR_EVENT;
1049 buf.frame_or_window = frame;
1050 buf.arg = frame;
1051 kbd_buffer_store_event (&buf);
1053 for (j = 0; j < submenu_depth; j++)
1054 if (!NILP (subprefix_stack[j]))
1056 buf.kind = MENU_BAR_EVENT;
1057 buf.frame_or_window = frame;
1058 buf.arg = subprefix_stack[j];
1059 kbd_buffer_store_event (&buf);
1062 if (!NILP (prefix))
1064 buf.kind = MENU_BAR_EVENT;
1065 buf.frame_or_window = frame;
1066 buf.arg = prefix;
1067 kbd_buffer_store_event (&buf);
1070 buf.kind = MENU_BAR_EVENT;
1071 buf.frame_or_window = frame;
1072 buf.arg = entry;
1073 kbd_buffer_store_event (&buf);
1075 f->output_data.mac->menubar_active = 0;
1076 return;
1078 i += MENU_ITEMS_ITEM_LENGTH;
1081 f->output_data.mac->menubar_active = 0;
1084 /* Allocate a widget_value, blocking input. */
1086 widget_value *
1087 xmalloc_widget_value ()
1089 widget_value *value;
1091 BLOCK_INPUT;
1092 value = malloc_widget_value ();
1093 UNBLOCK_INPUT;
1095 return value;
1098 /* This recursively calls free_widget_value on the tree of widgets.
1099 It must free all data that was malloc'ed for these widget_values.
1100 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1101 must be left alone. */
1103 void
1104 free_menubar_widget_value_tree (wv)
1105 widget_value *wv;
1107 if (! wv) return;
1109 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1111 if (wv->contents && (wv->contents != (widget_value*)1))
1113 free_menubar_widget_value_tree (wv->contents);
1114 wv->contents = (widget_value *) 0xDEADBEEF;
1116 if (wv->next)
1118 free_menubar_widget_value_tree (wv->next);
1119 wv->next = (widget_value *) 0xDEADBEEF;
1121 BLOCK_INPUT;
1122 free_widget_value (wv);
1123 UNBLOCK_INPUT;
1126 /* Set up data in menu_items for a menu bar item
1127 whose event type is ITEM_KEY (with string ITEM_NAME)
1128 and whose contents come from the list of keymaps MAPS. */
1130 static int
1131 parse_single_submenu (item_key, item_name, maps)
1132 Lisp_Object item_key, item_name, maps;
1134 Lisp_Object length;
1135 int len;
1136 Lisp_Object *mapvec;
1137 int i;
1138 int top_level_items = 0;
1140 length = Flength (maps);
1141 len = XINT (length);
1143 /* Convert the list MAPS into a vector MAPVEC. */
1144 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1145 for (i = 0; i < len; i++)
1147 mapvec[i] = Fcar (maps);
1148 maps = Fcdr (maps);
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 (!KEYMAPP (mapvec[i]))
1157 /* Here we have a command at top level in the menu bar
1158 as opposed to a submenu. */
1159 top_level_items = 1;
1160 push_menu_pane (Qnil, Qnil);
1161 push_menu_item (item_name, Qt, item_key, mapvec[i],
1162 Qnil, Qnil, Qnil, Qnil);
1164 else
1166 Lisp_Object prompt;
1167 prompt = Fkeymap_prompt (mapvec[i]);
1168 single_keymap_panes (mapvec[i],
1169 !NILP (prompt) ? prompt : item_name,
1170 item_key, 0, 10);
1174 return top_level_items;
1177 /* Create a tree of widget_value objects
1178 representing the panes and items
1179 in menu_items starting at index START, up to index END. */
1181 static widget_value *
1182 digest_single_submenu (start, end, top_level_items)
1183 int start, end, top_level_items;
1185 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1186 int i;
1187 int submenu_depth = 0;
1188 widget_value **submenu_stack;
1190 submenu_stack
1191 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1192 wv = xmalloc_widget_value ();
1193 wv->name = "menu";
1194 wv->value = 0;
1195 wv->enabled = 1;
1196 wv->button_type = BUTTON_TYPE_NONE;
1197 wv->help = Qnil;
1198 first_wv = wv;
1199 save_wv = 0;
1200 prev_wv = 0;
1202 /* Loop over all panes and items made by the preceding call
1203 to parse_single_submenu and construct a tree of widget_value objects.
1204 Ignore the panes and items used by previous calls to
1205 digest_single_submenu, even though those are also in menu_items. */
1206 i = start;
1207 while (i < end)
1209 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1211 submenu_stack[submenu_depth++] = save_wv;
1212 save_wv = prev_wv;
1213 prev_wv = 0;
1214 i++;
1216 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1218 prev_wv = save_wv;
1219 save_wv = submenu_stack[--submenu_depth];
1220 i++;
1222 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1223 && submenu_depth != 0)
1224 i += MENU_ITEMS_PANE_LENGTH;
1225 /* Ignore a nil in the item list.
1226 It's meaningful only for dialog boxes. */
1227 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1228 i += 1;
1229 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1231 /* Create a new pane. */
1232 Lisp_Object pane_name, prefix;
1233 char *pane_string;
1235 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1236 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1238 #ifndef HAVE_MULTILINGUAL_MENU
1239 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1241 pane_name = ENCODE_MENU_STRING (pane_name);
1242 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1244 #endif
1245 pane_string = (NILP (pane_name)
1246 ? "" : (char *) SDATA (pane_name));
1247 /* If there is just one top-level pane, put all its items directly
1248 under the top-level menu. */
1249 if (menu_items_n_panes == 1)
1250 pane_string = "";
1252 /* If the pane has a meaningful name,
1253 make the pane a top-level menu item
1254 with its items as a submenu beneath it. */
1255 if (strcmp (pane_string, ""))
1257 wv = xmalloc_widget_value ();
1258 if (save_wv)
1259 save_wv->next = wv;
1260 else
1261 first_wv->contents = wv;
1262 wv->lname = pane_name;
1263 /* Set value to 1 so update_submenu_strings can handle '@' */
1264 wv->value = (char *)1;
1265 wv->enabled = 1;
1266 wv->button_type = BUTTON_TYPE_NONE;
1267 wv->help = Qnil;
1269 save_wv = wv;
1270 prev_wv = 0;
1271 i += MENU_ITEMS_PANE_LENGTH;
1273 else
1275 /* Create a new item within current pane. */
1276 Lisp_Object item_name, enable, descrip, def, type, selected;
1277 Lisp_Object help;
1279 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1280 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1281 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1282 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1283 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1284 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1285 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1287 #ifndef HAVE_MULTILINGUAL_MENU
1288 if (STRING_MULTIBYTE (item_name))
1290 item_name = ENCODE_MENU_STRING (item_name);
1291 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1294 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1296 descrip = ENCODE_MENU_STRING (descrip);
1297 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1299 #endif /* not HAVE_MULTILINGUAL_MENU */
1301 wv = xmalloc_widget_value ();
1302 if (prev_wv)
1303 prev_wv->next = wv;
1304 else
1305 save_wv->contents = wv;
1307 wv->lname = item_name;
1308 if (!NILP (descrip))
1309 wv->lkey = descrip;
1310 wv->value = 0;
1311 /* The EMACS_INT cast avoids a warning. There's no problem
1312 as long as pointers have enough bits to hold small integers. */
1313 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1314 wv->enabled = !NILP (enable);
1316 if (NILP (type))
1317 wv->button_type = BUTTON_TYPE_NONE;
1318 else if (EQ (type, QCradio))
1319 wv->button_type = BUTTON_TYPE_RADIO;
1320 else if (EQ (type, QCtoggle))
1321 wv->button_type = BUTTON_TYPE_TOGGLE;
1322 else
1323 abort ();
1325 wv->selected = !NILP (selected);
1326 if (! STRINGP (help))
1327 help = Qnil;
1329 wv->help = help;
1331 prev_wv = wv;
1333 i += MENU_ITEMS_ITEM_LENGTH;
1337 /* If we have just one "menu item"
1338 that was originally a button, return it by itself. */
1339 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1341 wv = first_wv->contents;
1342 free_widget_value (first_wv);
1343 return wv;
1346 return first_wv;
1349 /* Walk through the widget_value tree starting at FIRST_WV and update
1350 the char * pointers from the corresponding lisp values.
1351 We do this after building the whole tree, since GC may happen while the
1352 tree is constructed, and small strings are relocated. So we must wait
1353 until no GC can happen before storing pointers into lisp values. */
1354 static void
1355 update_submenu_strings (first_wv)
1356 widget_value *first_wv;
1358 widget_value *wv;
1360 for (wv = first_wv; wv; wv = wv->next)
1362 if (STRINGP (wv->lname))
1364 wv->name = SDATA (wv->lname);
1366 /* Ignore the @ that means "separate pane".
1367 This is a kludge, but this isn't worth more time. */
1368 if (wv->value == (char *)1)
1370 if (wv->name[0] == '@')
1371 wv->name++;
1372 wv->value = 0;
1376 if (STRINGP (wv->lkey))
1377 wv->key = SDATA (wv->lkey);
1379 if (wv->contents)
1380 update_submenu_strings (wv->contents);
1385 /* Event handler function that pops down a menu on C-g. We can only pop
1386 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1388 #ifdef HAVE_CANCELMENUTRACKING
1389 static pascal OSStatus
1390 menu_quit_handler (nextHandler, theEvent, userData)
1391 EventHandlerCallRef nextHandler;
1392 EventRef theEvent;
1393 void* userData;
1395 UInt32 keyCode;
1396 UInt32 keyModifiers;
1397 extern int mac_quit_char_modifiers;
1398 extern int mac_quit_char_keycode;
1400 GetEventParameter (theEvent, kEventParamKeyCode,
1401 typeUInt32, NULL, sizeof(UInt32), NULL, &keyCode);
1403 GetEventParameter (theEvent, kEventParamKeyModifiers,
1404 typeUInt32, NULL, sizeof(UInt32),
1405 NULL, &keyModifiers);
1407 if (keyCode == mac_quit_char_keycode
1408 && keyModifiers == mac_quit_char_modifiers)
1410 MenuRef menu = userData != 0
1411 ? (MenuRef)userData : AcquireRootMenu ();
1413 CancelMenuTracking (menu, true, 0);
1414 if (!userData) ReleaseMenu (menu);
1415 return noErr;
1418 return CallNextEventHandler (nextHandler, theEvent);
1420 #endif /* HAVE_CANCELMENUTRACKING */
1422 /* Add event handler for MENU_HANDLE so we can detect C-g.
1423 If MENU_HANDLE is NULL, install handler for all menus in the menu bar.
1424 If CancelMenuTracking isn't available, do nothing. */
1426 static void
1427 install_menu_quit_handler (MenuHandle menu_handle)
1429 #ifdef HAVE_CANCELMENUTRACKING
1430 EventTypeSpec typesList[] = { { kEventClassKeyboard, kEventRawKeyDown } };
1431 int i = MIN_MENU_ID;
1432 MenuHandle menu = menu_handle ? menu_handle : GetMenuHandle (i);
1434 while (menu != NULL)
1436 InstallMenuEventHandler (menu, menu_quit_handler,
1437 GetEventTypeCount (typesList),
1438 typesList, menu_handle, NULL);
1439 if (menu_handle) break;
1440 menu = GetMenuHandle (++i);
1443 i = menu_handle ? MIN_POPUP_SUBMENU_ID : MIN_SUBMENU_ID;
1444 menu = GetMenuHandle (i);
1445 while (menu != NULL)
1447 InstallMenuEventHandler (menu, menu_quit_handler,
1448 GetEventTypeCount (typesList),
1449 typesList, menu_handle, NULL);
1450 menu = GetMenuHandle (++i);
1452 #endif /* HAVE_CANCELMENUTRACKING */
1455 /* Set the contents of the menubar widgets of frame F.
1456 The argument FIRST_TIME is currently ignored;
1457 it is set the first time this is called, from initialize_frame_menubar. */
1459 void
1460 set_frame_menubar (f, first_time, deep_p)
1461 FRAME_PTR f;
1462 int first_time;
1463 int deep_p;
1465 int menubar_widget = f->output_data.mac->menubar_widget;
1466 Lisp_Object items;
1467 widget_value *wv, *first_wv, *prev_wv = 0;
1468 int i, last_i = 0;
1469 int *submenu_start, *submenu_end;
1470 int *submenu_top_level_items, *submenu_n_panes;
1472 /* We must not change the menubar when actually in use. */
1473 if (f->output_data.mac->menubar_active)
1474 return;
1476 XSETFRAME (Vmenu_updating_frame, f);
1478 if (! menubar_widget)
1479 deep_p = 1;
1480 else if (pending_menu_activation && !deep_p)
1481 deep_p = 1;
1483 if (deep_p)
1485 /* Make a widget-value tree representing the entire menu trees. */
1487 struct buffer *prev = current_buffer;
1488 Lisp_Object buffer;
1489 int specpdl_count = SPECPDL_INDEX ();
1490 int previous_menu_items_used = f->menu_bar_items_used;
1491 Lisp_Object *previous_items
1492 = (Lisp_Object *) alloca (previous_menu_items_used
1493 * sizeof (Lisp_Object));
1495 /* If we are making a new widget, its contents are empty,
1496 do always reinitialize them. */
1497 if (! menubar_widget)
1498 previous_menu_items_used = 0;
1500 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1501 specbind (Qinhibit_quit, Qt);
1502 /* Don't let the debugger step into this code
1503 because it is not reentrant. */
1504 specbind (Qdebug_on_next_call, Qnil);
1506 record_unwind_save_match_data ();
1507 if (NILP (Voverriding_local_map_menu_flag))
1509 specbind (Qoverriding_terminal_local_map, Qnil);
1510 specbind (Qoverriding_local_map, Qnil);
1513 set_buffer_internal_1 (XBUFFER (buffer));
1515 /* Run the Lucid hook. */
1516 safe_run_hooks (Qactivate_menubar_hook);
1518 /* If it has changed current-menubar from previous value,
1519 really recompute the menubar from the value. */
1520 if (! NILP (Vlucid_menu_bar_dirty_flag))
1521 call0 (Qrecompute_lucid_menubar);
1522 safe_run_hooks (Qmenu_bar_update_hook);
1523 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1525 items = FRAME_MENU_BAR_ITEMS (f);
1527 /* Save the frame's previous menu bar contents data. */
1528 if (previous_menu_items_used)
1529 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1530 previous_menu_items_used * sizeof (Lisp_Object));
1532 /* Fill in menu_items with the current menu bar contents.
1533 This can evaluate Lisp code. */
1534 menu_items = f->menu_bar_vector;
1535 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1536 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1537 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1538 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1539 submenu_top_level_items
1540 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1541 init_menu_items ();
1542 for (i = 0; i < XVECTOR (items)->size; i += 4)
1544 Lisp_Object key, string, maps;
1546 last_i = i;
1548 key = XVECTOR (items)->contents[i];
1549 string = XVECTOR (items)->contents[i + 1];
1550 maps = XVECTOR (items)->contents[i + 2];
1551 if (NILP (string))
1552 break;
1554 submenu_start[i] = menu_items_used;
1556 menu_items_n_panes = 0;
1557 submenu_top_level_items[i]
1558 = parse_single_submenu (key, string, maps);
1559 submenu_n_panes[i] = menu_items_n_panes;
1561 submenu_end[i] = menu_items_used;
1564 finish_menu_items ();
1566 /* Convert menu_items into widget_value trees
1567 to display the menu. This cannot evaluate Lisp code. */
1569 wv = xmalloc_widget_value ();
1570 wv->name = "menubar";
1571 wv->value = 0;
1572 wv->enabled = 1;
1573 wv->button_type = BUTTON_TYPE_NONE;
1574 wv->help = Qnil;
1575 first_wv = wv;
1577 for (i = 0; i < last_i; i += 4)
1579 menu_items_n_panes = submenu_n_panes[i];
1580 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1581 submenu_top_level_items[i]);
1582 if (prev_wv)
1583 prev_wv->next = wv;
1584 else
1585 first_wv->contents = wv;
1586 /* Don't set wv->name here; GC during the loop might relocate it. */
1587 wv->enabled = 1;
1588 wv->button_type = BUTTON_TYPE_NONE;
1589 prev_wv = wv;
1592 set_buffer_internal_1 (prev);
1593 unbind_to (specpdl_count, Qnil);
1595 /* If there has been no change in the Lisp-level contents
1596 of the menu bar, skip redisplaying it. Just exit. */
1598 for (i = 0; i < previous_menu_items_used; i++)
1599 if (menu_items_used == i
1600 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1601 break;
1602 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1604 free_menubar_widget_value_tree (first_wv);
1605 discard_menu_items ();
1607 return;
1610 /* Now GC cannot happen during the lifetime of the widget_value,
1611 so it's safe to store data from a Lisp_String. */
1612 wv = first_wv->contents;
1613 for (i = 0; i < XVECTOR (items)->size; i += 4)
1615 Lisp_Object string;
1616 string = XVECTOR (items)->contents[i + 1];
1617 if (NILP (string))
1618 break;
1619 wv->name = (char *) SDATA (string);
1620 update_submenu_strings (wv->contents);
1621 wv = wv->next;
1624 f->menu_bar_vector = menu_items;
1625 f->menu_bar_items_used = menu_items_used;
1626 discard_menu_items ();
1628 else
1630 /* Make a widget-value tree containing
1631 just the top level menu bar strings. */
1633 wv = xmalloc_widget_value ();
1634 wv->name = "menubar";
1635 wv->value = 0;
1636 wv->enabled = 1;
1637 wv->button_type = BUTTON_TYPE_NONE;
1638 wv->help = Qnil;
1639 first_wv = wv;
1641 items = FRAME_MENU_BAR_ITEMS (f);
1642 for (i = 0; i < XVECTOR (items)->size; i += 4)
1644 Lisp_Object string;
1646 string = XVECTOR (items)->contents[i + 1];
1647 if (NILP (string))
1648 break;
1650 wv = xmalloc_widget_value ();
1651 wv->name = (char *) SDATA (string);
1652 wv->value = 0;
1653 wv->enabled = 1;
1654 wv->button_type = BUTTON_TYPE_NONE;
1655 wv->help = Qnil;
1656 /* This prevents lwlib from assuming this
1657 menu item is really supposed to be empty. */
1658 /* The EMACS_INT cast avoids a warning.
1659 This value just has to be different from small integers. */
1660 wv->call_data = (void *) (EMACS_INT) (-1);
1662 if (prev_wv)
1663 prev_wv->next = wv;
1664 else
1665 first_wv->contents = wv;
1666 prev_wv = wv;
1669 /* Forget what we thought we knew about what is in the
1670 detailed contents of the menu bar menus.
1671 Changing the top level always destroys the contents. */
1672 f->menu_bar_items_used = 0;
1675 /* Create or update the menu bar widget. */
1677 BLOCK_INPUT;
1679 /* Non-null value to indicate menubar has already been "created". */
1680 f->output_data.mac->menubar_widget = 1;
1683 int i = MIN_MENU_ID;
1684 MenuHandle menu = GetMenuHandle (i);
1685 while (menu != NULL)
1687 DeleteMenu (i);
1688 DisposeMenu (menu);
1689 menu = GetMenuHandle (++i);
1692 i = MIN_SUBMENU_ID;
1693 menu = GetMenuHandle (i);
1694 while (menu != NULL)
1696 DeleteMenu (i);
1697 DisposeMenu (menu);
1698 menu = GetMenuHandle (++i);
1702 fill_menubar (first_wv->contents);
1704 /* Add event handler so we can detect C-g. */
1705 install_menu_quit_handler (NULL);
1706 free_menubar_widget_value_tree (first_wv);
1708 UNBLOCK_INPUT;
1711 /* Called from Fx_create_frame to create the initial menubar of a frame
1712 before it is mapped, so that the window is mapped with the menubar already
1713 there instead of us tacking it on later and thrashing the window after it
1714 is visible. */
1716 void
1717 initialize_frame_menubar (f)
1718 FRAME_PTR f;
1720 /* This function is called before the first chance to redisplay
1721 the frame. It has to be, so the frame will have the right size. */
1722 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1723 set_frame_menubar (f, 1, 1);
1727 /* Get rid of the menu bar of frame F, and free its storage.
1728 This is used when deleting a frame, and when turning off the menu bar. */
1730 void
1731 free_frame_menubar (f)
1732 FRAME_PTR f;
1734 f->output_data.mac->menubar_widget = 0;
1738 static Lisp_Object
1739 pop_down_menu (arg)
1740 Lisp_Object arg;
1742 struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg));
1743 struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg));
1745 FRAME_PTR f = p1->pointer;
1746 MenuHandle *menu = p2->pointer;
1748 BLOCK_INPUT;
1750 /* Must reset this manually because the button release event is not
1751 passed to Emacs event loop. */
1752 FRAME_MAC_DISPLAY_INFO (f)->grabbed = 0;
1754 /* delete all menus */
1756 int i = MIN_POPUP_SUBMENU_ID;
1757 MenuHandle submenu = GetMenuHandle (i);
1758 while (submenu != NULL)
1760 DeleteMenu (i);
1761 DisposeMenu (submenu);
1762 submenu = GetMenuHandle (++i);
1766 DeleteMenu (POPUP_SUBMENU_ID);
1767 DisposeMenu (*menu);
1769 UNBLOCK_INPUT;
1771 return Qnil;
1774 /* Mac_menu_show actually displays a menu using the panes and items in
1775 menu_items and returns the value selected from it; we assume input
1776 is blocked by the caller. */
1778 /* F is the frame the menu is for.
1779 X and Y are the frame-relative specified position,
1780 relative to the inside upper left corner of the frame F.
1781 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1782 KEYMAPS is 1 if this menu was specified with keymaps;
1783 in that case, we return a list containing the chosen item's value
1784 and perhaps also the pane's prefix.
1785 TITLE is the specified menu title.
1786 ERROR is a place to store an error message string in case of failure.
1787 (We return nil on failure, but the value doesn't actually matter.) */
1789 static Lisp_Object
1790 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1791 FRAME_PTR f;
1792 int x;
1793 int y;
1794 int for_click;
1795 int keymaps;
1796 Lisp_Object title;
1797 char **error;
1799 int i;
1800 UInt32 refcon;
1801 int menu_item_choice;
1802 int menu_item_selection;
1803 MenuHandle menu;
1804 Point pos;
1805 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1806 widget_value **submenu_stack
1807 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1808 Lisp_Object *subprefix_stack
1809 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1810 int submenu_depth = 0;
1812 int first_pane;
1813 int specpdl_count = SPECPDL_INDEX ();
1815 *error = NULL;
1817 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1819 *error = "Empty menu";
1820 return Qnil;
1823 /* Create a tree of widget_value objects
1824 representing the panes and their items. */
1825 wv = xmalloc_widget_value ();
1826 wv->name = "menu";
1827 wv->value = 0;
1828 wv->enabled = 1;
1829 wv->button_type = BUTTON_TYPE_NONE;
1830 wv->help = Qnil;
1831 first_wv = wv;
1832 first_pane = 1;
1834 /* Loop over all panes and items, filling in the tree. */
1835 i = 0;
1836 while (i < menu_items_used)
1838 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1840 submenu_stack[submenu_depth++] = save_wv;
1841 save_wv = prev_wv;
1842 prev_wv = 0;
1843 first_pane = 1;
1844 i++;
1846 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1848 prev_wv = save_wv;
1849 save_wv = submenu_stack[--submenu_depth];
1850 first_pane = 0;
1851 i++;
1853 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1854 && submenu_depth != 0)
1855 i += MENU_ITEMS_PANE_LENGTH;
1856 /* Ignore a nil in the item list.
1857 It's meaningful only for dialog boxes. */
1858 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1859 i += 1;
1860 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1862 /* Create a new pane. */
1863 Lisp_Object pane_name, prefix;
1864 char *pane_string;
1866 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1867 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1869 #ifndef HAVE_MULTILINGUAL_MENU
1870 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1872 pane_name = ENCODE_MENU_STRING (pane_name);
1873 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1875 #endif
1876 pane_string = (NILP (pane_name)
1877 ? "" : (char *) SDATA (pane_name));
1878 /* If there is just one top-level pane, put all its items directly
1879 under the top-level menu. */
1880 if (menu_items_n_panes == 1)
1881 pane_string = "";
1883 /* If the pane has a meaningful name,
1884 make the pane a top-level menu item
1885 with its items as a submenu beneath it. */
1886 if (!keymaps && strcmp (pane_string, ""))
1888 wv = xmalloc_widget_value ();
1889 if (save_wv)
1890 save_wv->next = wv;
1891 else
1892 first_wv->contents = wv;
1893 wv->name = pane_string;
1894 if (keymaps && !NILP (prefix))
1895 wv->name++;
1896 wv->value = 0;
1897 wv->enabled = 1;
1898 wv->button_type = BUTTON_TYPE_NONE;
1899 wv->help = Qnil;
1900 save_wv = wv;
1901 prev_wv = 0;
1903 else if (first_pane)
1905 save_wv = wv;
1906 prev_wv = 0;
1908 first_pane = 0;
1909 i += MENU_ITEMS_PANE_LENGTH;
1911 else
1913 /* Create a new item within current pane. */
1914 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1915 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1916 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1917 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1918 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1919 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1920 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1921 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1923 #ifndef HAVE_MULTILINGUAL_MENU
1924 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1926 item_name = ENCODE_MENU_STRING (item_name);
1927 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1930 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1932 descrip = ENCODE_MENU_STRING (descrip);
1933 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1935 #endif /* not HAVE_MULTILINGUAL_MENU */
1937 wv = xmalloc_widget_value ();
1938 if (prev_wv)
1939 prev_wv->next = wv;
1940 else
1941 save_wv->contents = wv;
1942 wv->name = (char *) SDATA (item_name);
1943 if (!NILP (descrip))
1944 wv->key = (char *) SDATA (descrip);
1945 wv->value = 0;
1946 /* Use the contents index as call_data, since we are
1947 restricted to 16-bits. */
1948 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1949 wv->enabled = !NILP (enable);
1951 if (NILP (type))
1952 wv->button_type = BUTTON_TYPE_NONE;
1953 else if (EQ (type, QCtoggle))
1954 wv->button_type = BUTTON_TYPE_TOGGLE;
1955 else if (EQ (type, QCradio))
1956 wv->button_type = BUTTON_TYPE_RADIO;
1957 else
1958 abort ();
1960 wv->selected = !NILP (selected);
1962 if (! STRINGP (help))
1963 help = Qnil;
1965 wv->help = help;
1967 prev_wv = wv;
1969 i += MENU_ITEMS_ITEM_LENGTH;
1973 /* Deal with the title, if it is non-nil. */
1974 if (!NILP (title))
1976 widget_value *wv_title = xmalloc_widget_value ();
1977 widget_value *wv_sep = xmalloc_widget_value ();
1979 /* Maybe replace this separator with a bitmap or owner-draw item
1980 so that it looks better. Having two separators looks odd. */
1981 wv_sep->name = "--";
1982 wv_sep->next = first_wv->contents;
1983 wv_sep->help = Qnil;
1985 #ifndef HAVE_MULTILINGUAL_MENU
1986 if (STRING_MULTIBYTE (title))
1987 title = ENCODE_MENU_STRING (title);
1988 #endif
1990 wv_title->name = (char *) SDATA (title);
1991 wv_title->enabled = FALSE;
1992 wv_title->title = TRUE;
1993 wv_title->button_type = BUTTON_TYPE_NONE;
1994 wv_title->help = Qnil;
1995 wv_title->next = wv_sep;
1996 first_wv->contents = wv_title;
1999 /* Actually create the menu. */
2000 menu = NewMenu (POPUP_SUBMENU_ID, "\p");
2001 submenu_id = MIN_POPUP_SUBMENU_ID;
2002 fill_submenu (menu, first_wv->contents);
2004 /* Free the widget_value objects we used to specify the
2005 contents. */
2006 free_menubar_widget_value_tree (first_wv);
2008 /* Adjust coordinates to be root-window-relative. */
2009 pos.h = x;
2010 pos.v = y;
2012 SetPortWindowPort (FRAME_MAC_WINDOW (f));
2013 LocalToGlobal (&pos);
2015 /* No selection has been chosen yet. */
2016 menu_item_choice = 0;
2017 menu_item_selection = 0;
2019 InsertMenu (menu, -1);
2021 record_unwind_protect (pop_down_menu,
2022 Fcons (make_save_value (f, 0),
2023 make_save_value (&menu, 0)));
2025 /* Add event handler so we can detect C-g. */
2026 install_menu_quit_handler (menu);
2028 /* Display the menu. */
2029 menu_item_choice = PopUpMenuSelect (menu, pos.v, pos.h, 0);
2030 menu_item_selection = LoWord (menu_item_choice);
2032 /* Get the refcon to find the correct item */
2033 if (menu_item_selection)
2035 MenuHandle sel_menu = GetMenuHandle (HiWord (menu_item_choice));
2036 if (sel_menu) {
2037 GetMenuItemRefCon (sel_menu, menu_item_selection, &refcon);
2040 else if (! for_click)
2041 /* Make "Cancel" equivalent to C-g unless this menu was popped up by
2042 a mouse press. */
2043 Fsignal (Qquit, Qnil);
2045 /* Find the selected item, and its pane, to return
2046 the proper value. */
2047 if (menu_item_selection != 0)
2049 Lisp_Object prefix, entry;
2051 prefix = entry = Qnil;
2052 i = 0;
2053 while (i < menu_items_used)
2055 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2057 subprefix_stack[submenu_depth++] = prefix;
2058 prefix = entry;
2059 i++;
2061 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2063 prefix = subprefix_stack[--submenu_depth];
2064 i++;
2066 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2068 prefix
2069 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2070 i += MENU_ITEMS_PANE_LENGTH;
2072 /* Ignore a nil in the item list.
2073 It's meaningful only for dialog boxes. */
2074 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2075 i += 1;
2076 else
2078 entry
2079 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2080 if ((int) (EMACS_INT) refcon == i)
2082 if (keymaps != 0)
2084 int j;
2086 entry = Fcons (entry, Qnil);
2087 if (!NILP (prefix))
2088 entry = Fcons (prefix, entry);
2089 for (j = submenu_depth - 1; j >= 0; j--)
2090 if (!NILP (subprefix_stack[j]))
2091 entry = Fcons (subprefix_stack[j], entry);
2093 return entry;
2095 i += MENU_ITEMS_ITEM_LENGTH;
2099 else if (!for_click)
2100 /* Make "Cancel" equivalent to C-g. */
2101 Fsignal (Qquit, Qnil);
2103 unbind_to (specpdl_count, Qnil);
2105 return Qnil;
2109 #ifdef HAVE_DIALOGS
2110 /* Construct native Mac OS menubar based on widget_value tree. */
2112 static int
2113 mac_dialog (widget_value *wv)
2115 char *dialog_name;
2116 char *prompt;
2117 char **button_labels;
2118 UInt32 *ref_cons;
2119 int nb_buttons;
2120 int left_count;
2121 int i;
2122 int dialog_width;
2123 Rect rect;
2124 WindowPtr window_ptr;
2125 ControlHandle ch;
2126 int left;
2127 EventRecord event_record;
2128 SInt16 part_code;
2129 int control_part_code;
2130 Point mouse;
2132 dialog_name = wv->name;
2133 nb_buttons = dialog_name[1] - '0';
2134 left_count = nb_buttons - (dialog_name[4] - '0');
2135 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
2136 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
2138 wv = wv->contents;
2139 prompt = (char *) alloca (strlen (wv->value) + 1);
2140 strcpy (prompt, wv->value);
2141 c2pstr (prompt);
2143 wv = wv->next;
2144 for (i = 0; i < nb_buttons; i++)
2146 button_labels[i] = wv->value;
2147 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
2148 strcpy (button_labels[i], wv->value);
2149 c2pstr (button_labels[i]);
2150 ref_cons[i] = (UInt32) wv->call_data;
2151 wv = wv->next;
2154 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
2156 SetPortWindowPort (window_ptr);
2158 TextFont (0);
2159 /* Left and right margins in the dialog are 13 pixels each.*/
2160 dialog_width = 14;
2161 /* Calculate width of dialog box: 8 pixels on each side of the text
2162 label in each button, 12 pixels between buttons. */
2163 for (i = 0; i < nb_buttons; i++)
2164 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
2166 if (left_count != 0 && nb_buttons - left_count != 0)
2167 dialog_width += 12;
2169 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
2171 SizeWindow (window_ptr, dialog_width, 78, 0);
2172 ShowWindow (window_ptr);
2174 SetPortWindowPort (window_ptr);
2176 TextFont (0);
2178 MoveTo (13, 29);
2179 DrawString (prompt);
2181 left = 13;
2182 for (i = 0; i < nb_buttons; i++)
2184 int button_width = StringWidth (button_labels[i]) + 16;
2185 SetRect (&rect, left, 45, left + button_width, 65);
2186 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2187 kControlPushButtonProc, ref_cons[i]);
2188 left += button_width + 12;
2189 if (i == left_count - 1)
2190 left += 12;
2193 i = 0;
2194 while (!i)
2196 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2197 if (event_record.what == mouseDown)
2199 part_code = FindWindow (event_record.where, &window_ptr);
2200 if (part_code == inContent)
2202 mouse = event_record.where;
2203 GlobalToLocal (&mouse);
2204 control_part_code = FindControl (mouse, window_ptr, &ch);
2205 if (control_part_code == kControlButtonPart)
2206 if (TrackControl (ch, mouse, NULL))
2207 i = GetControlReference (ch);
2212 DisposeWindow (window_ptr);
2214 return i;
2217 static char * button_names [] = {
2218 "button1", "button2", "button3", "button4", "button5",
2219 "button6", "button7", "button8", "button9", "button10" };
2221 static Lisp_Object
2222 mac_dialog_show (f, keymaps, title, header, error_name)
2223 FRAME_PTR f;
2224 int keymaps;
2225 Lisp_Object title, header;
2226 char **error_name;
2228 int i, nb_buttons=0;
2229 char dialog_name[6];
2230 int menu_item_selection;
2232 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2234 /* Number of elements seen so far, before boundary. */
2235 int left_count = 0;
2236 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2237 int boundary_seen = 0;
2239 *error_name = NULL;
2241 if (menu_items_n_panes > 1)
2243 *error_name = "Multiple panes in dialog box";
2244 return Qnil;
2247 /* Create a tree of widget_value objects
2248 representing the text label and buttons. */
2250 Lisp_Object pane_name, prefix;
2251 char *pane_string;
2252 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2253 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2254 pane_string = (NILP (pane_name)
2255 ? "" : (char *) SDATA (pane_name));
2256 prev_wv = xmalloc_widget_value ();
2257 prev_wv->value = pane_string;
2258 if (keymaps && !NILP (prefix))
2259 prev_wv->name++;
2260 prev_wv->enabled = 1;
2261 prev_wv->name = "message";
2262 prev_wv->help = Qnil;
2263 first_wv = prev_wv;
2265 /* Loop over all panes and items, filling in the tree. */
2266 i = MENU_ITEMS_PANE_LENGTH;
2267 while (i < menu_items_used)
2270 /* Create a new item within current pane. */
2271 Lisp_Object item_name, enable, descrip;
2272 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2273 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2274 descrip
2275 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2277 if (NILP (item_name))
2279 free_menubar_widget_value_tree (first_wv);
2280 *error_name = "Submenu in dialog items";
2281 return Qnil;
2283 if (EQ (item_name, Qquote))
2285 /* This is the boundary between left-side elts
2286 and right-side elts. Stop incrementing right_count. */
2287 boundary_seen = 1;
2288 i++;
2289 continue;
2291 if (nb_buttons >= 9)
2293 free_menubar_widget_value_tree (first_wv);
2294 *error_name = "Too many dialog items";
2295 return Qnil;
2298 wv = xmalloc_widget_value ();
2299 prev_wv->next = wv;
2300 wv->name = (char *) button_names[nb_buttons];
2301 if (!NILP (descrip))
2302 wv->key = (char *) SDATA (descrip);
2303 wv->value = (char *) SDATA (item_name);
2304 wv->call_data = (void *) i;
2305 /* menu item is identified by its index in menu_items table */
2306 wv->enabled = !NILP (enable);
2307 wv->help = Qnil;
2308 prev_wv = wv;
2310 if (! boundary_seen)
2311 left_count++;
2313 nb_buttons++;
2314 i += MENU_ITEMS_ITEM_LENGTH;
2317 /* If the boundary was not specified,
2318 by default put half on the left and half on the right. */
2319 if (! boundary_seen)
2320 left_count = nb_buttons - nb_buttons / 2;
2322 wv = xmalloc_widget_value ();
2323 wv->name = dialog_name;
2324 wv->help = Qnil;
2326 /* Frame title: 'Q' = Question, 'I' = Information.
2327 Can also have 'E' = Error if, one day, we want
2328 a popup for errors. */
2329 if (NILP(header))
2330 dialog_name[0] = 'Q';
2331 else
2332 dialog_name[0] = 'I';
2334 /* Dialog boxes use a really stupid name encoding
2335 which specifies how many buttons to use
2336 and how many buttons are on the right. */
2337 dialog_name[1] = '0' + nb_buttons;
2338 dialog_name[2] = 'B';
2339 dialog_name[3] = 'R';
2340 /* Number of buttons to put on the right. */
2341 dialog_name[4] = '0' + nb_buttons - left_count;
2342 dialog_name[5] = 0;
2343 wv->contents = first_wv;
2344 first_wv = wv;
2347 /* Actually create the dialog. */
2348 #ifdef HAVE_DIALOGS
2349 menu_item_selection = mac_dialog (first_wv);
2350 #else
2351 menu_item_selection = 0;
2352 #endif
2354 /* Free the widget_value objects we used to specify the contents. */
2355 free_menubar_widget_value_tree (first_wv);
2357 /* Find the selected item, and its pane, to return
2358 the proper value. */
2359 if (menu_item_selection != 0)
2361 Lisp_Object prefix;
2363 prefix = Qnil;
2364 i = 0;
2365 while (i < menu_items_used)
2367 Lisp_Object entry;
2369 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2371 prefix
2372 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2373 i += MENU_ITEMS_PANE_LENGTH;
2375 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2377 /* This is the boundary between left-side elts and
2378 right-side elts. */
2379 ++i;
2381 else
2383 entry
2384 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2385 if (menu_item_selection == i)
2387 if (keymaps != 0)
2389 entry = Fcons (entry, Qnil);
2390 if (!NILP (prefix))
2391 entry = Fcons (prefix, entry);
2393 return entry;
2395 i += MENU_ITEMS_ITEM_LENGTH;
2399 else
2400 /* Make "Cancel" equivalent to C-g. */
2401 Fsignal (Qquit, Qnil);
2403 return Qnil;
2405 #endif /* HAVE_DIALOGS */
2408 /* Is this item a separator? */
2409 static int
2410 name_is_separator (name)
2411 char *name;
2413 char *start = name;
2415 /* Check if name string consists of only dashes ('-'). */
2416 while (*name == '-') name++;
2417 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2418 or "--deep-shadow". We don't implement them yet, se we just treat
2419 them like normal separators. */
2420 return (*name == '\0' || start + 2 == name);
2423 static void
2424 add_menu_item (MenuHandle menu, widget_value *wv, int submenu,
2425 int force_disable)
2427 #if TARGET_API_MAC_CARBON
2428 CFStringRef item_name;
2429 #else
2430 Str255 item_name;
2431 #endif
2432 int pos;
2434 if (name_is_separator (wv->name))
2435 AppendMenu (menu, "\p-");
2436 else
2438 AppendMenu (menu, "\pX");
2440 #if TARGET_API_MAC_CARBON
2441 pos = CountMenuItems (menu);
2443 item_name = cfstring_create_with_utf8_cstring (wv->name);
2445 if (wv->key != NULL)
2447 CFStringRef name, key;
2449 name = item_name;
2450 key = cfstring_create_with_utf8_cstring (wv->key);
2451 item_name = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@ %@"),
2452 name, key);
2453 CFRelease (name);
2454 CFRelease (key);
2457 SetMenuItemTextWithCFString (menu, pos, item_name);
2458 CFRelease (item_name);
2460 if (wv->enabled && !force_disable)
2461 EnableMenuItem (menu, pos);
2462 else
2463 DisableMenuItem (menu, pos);
2464 #else /* ! TARGET_API_MAC_CARBON */
2465 pos = CountMItems (menu);
2467 item_name[sizeof (item_name) - 1] = '\0';
2468 strncpy (item_name, wv->name, sizeof (item_name) - 1);
2469 if (wv->key != NULL)
2471 int len = strlen (item_name);
2473 strncpy (item_name + len, " ", sizeof (item_name) - 1 - len);
2474 len = strlen (item_name);
2475 strncpy (item_name + len, wv->key, sizeof (item_name) - 1 - len);
2477 c2pstr (item_name);
2478 SetMenuItemText (menu, pos, item_name);
2480 if (wv->enabled && !force_disable)
2481 EnableItem (menu, pos);
2482 else
2483 DisableItem (menu, pos);
2484 #endif /* ! TARGET_API_MAC_CARBON */
2486 /* Draw radio buttons and tickboxes. */
2488 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2489 wv->button_type == BUTTON_TYPE_RADIO))
2490 SetItemMark (menu, pos, checkMark);
2491 else
2492 SetItemMark (menu, pos, noMark);
2495 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
2498 if (submenu != 0)
2499 SetMenuItemHierarchicalID (menu, pos, submenu);
2502 /* Construct native Mac OS menubar based on widget_value tree. */
2504 static void
2505 fill_submenu (MenuHandle menu, widget_value *wv)
2507 for ( ; wv != NULL; wv = wv->next)
2508 if (wv->contents)
2510 int cur_submenu = submenu_id++;
2511 MenuHandle submenu = NewMenu (cur_submenu, "\pX");
2512 fill_submenu (submenu, wv->contents);
2513 InsertMenu (submenu, -1);
2514 add_menu_item (menu, wv, cur_submenu, 0);
2516 else
2517 add_menu_item (menu, wv, 0, 0);
2521 /* Construct native Mac OS menu based on widget_value tree. */
2523 static void
2524 fill_menu (MenuHandle menu, widget_value *wv)
2526 for ( ; wv != NULL; wv = wv->next)
2527 if (wv->contents)
2529 int cur_submenu = submenu_id++;
2530 MenuHandle submenu = NewMenu (cur_submenu, "\pX");
2531 fill_submenu (submenu, wv->contents);
2532 InsertMenu (submenu, -1);
2533 add_menu_item (menu, wv, cur_submenu, 0);
2535 else
2536 add_menu_item (menu, wv, 0, 0);
2539 /* Construct native Mac OS menubar based on widget_value tree. */
2541 static void
2542 fill_menubar (widget_value *wv)
2544 int id;
2546 submenu_id = MIN_SUBMENU_ID;
2548 for (id = MIN_MENU_ID; wv != NULL; wv = wv->next, id++)
2550 MenuHandle menu;
2551 Str255 title;
2553 strncpy (title, wv->name, 255);
2554 title[255] = 0;
2555 c2pstr (title);
2556 menu = NewMenu (id, title);
2558 if (wv->contents)
2559 fill_menu (menu, wv->contents);
2561 InsertMenu (menu, 0);
2565 #endif /* HAVE_MENUS */
2567 void
2568 syms_of_macmenu ()
2570 staticpro (&menu_items);
2571 menu_items = Qnil;
2573 Qdebug_on_next_call = intern ("debug-on-next-call");
2574 staticpro (&Qdebug_on_next_call);
2576 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2577 doc: /* Frame for which we are updating a menu.
2578 The enable predicate for a menu command should check this variable. */);
2579 Vmenu_updating_frame = Qnil;
2581 defsubr (&Sx_popup_menu);
2582 #ifdef HAVE_MENUS
2583 defsubr (&Sx_popup_dialog);
2584 #endif
2587 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2588 (do not change this comment) */