(select-message-coding-system): Be
[emacs.git] / src / macmenu.c
blobc7ee0dfaf211c3322597dfb690f425b89e6b39d1
1 /* Menu support for GNU Emacs on the for Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA. */
21 /* Contributed by Andrew Choi (akochoi@mac.com). */
23 #include <config.h>
25 #include <stdio.h>
26 #include "lisp.h"
27 #include "termhooks.h"
28 #include "keyboard.h"
29 #include "keymap.h"
30 #include "frame.h"
31 #include "window.h"
32 #include "blockinput.h"
33 #include "buffer.h"
34 #include "charset.h"
35 #include "coding.h"
37 #if !TARGET_API_MAC_CARBON
38 #include <MacTypes.h>
39 #include <Menus.h>
40 #include <QuickDraw.h>
41 #include <ToolUtils.h>
42 #include <Fonts.h>
43 #include <Controls.h>
44 #include <Windows.h>
45 #include <Events.h>
46 #if defined (__MRC__) || (__MSL__ >= 0x6000)
47 #include <ControlDefinitions.h>
48 #endif
49 #endif /* not TARGET_API_MAC_CARBON */
51 /* This may include sys/types.h, and that somehow loses
52 if this is not done before the other system files. */
53 #include "macterm.h"
55 /* Load sys/types.h if not already loaded.
56 In some systems loading it twice is suicidal. */
57 #ifndef makedev
58 #include <sys/types.h>
59 #endif
61 #include "dispextern.h"
63 #define POPUP_SUBMENU_ID 235
64 #define MIN_POPUP_SUBMENU_ID 512
65 #define MIN_MENU_ID 256
66 #define MIN_SUBMENU_ID 1
68 #define DIALOG_WINDOW_RESOURCE 130
70 #define HAVE_DIALOGS 1
72 #undef HAVE_MULTILINGUAL_MENU
73 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
75 /******************************************************************/
76 /* Definitions copied from lwlib.h */
78 typedef void * XtPointer;
80 enum button_type
82 BUTTON_TYPE_NONE,
83 BUTTON_TYPE_TOGGLE,
84 BUTTON_TYPE_RADIO
87 /* This structure is based on the one in ../lwlib/lwlib.h, modified
88 for Mac OS. */
89 typedef struct _widget_value
91 /* name of widget */
92 Lisp_Object lname;
93 char* name;
94 /* value (meaning depend on widget type) */
95 char* value;
96 /* keyboard equivalent. no implications for XtTranslations */
97 Lisp_Object lkey;
98 char* key;
99 /* Help string or nil if none.
100 GC finds this string through the frame's menu_bar_vector
101 or through menu_items. */
102 Lisp_Object help;
103 /* true if enabled */
104 Boolean enabled;
105 /* true if selected */
106 Boolean selected;
107 /* The type of a button. */
108 enum button_type button_type;
109 /* true if menu title */
110 Boolean title;
111 #if 0
112 /* true if was edited (maintained by get_value) */
113 Boolean edited;
114 /* true if has changed (maintained by lw library) */
115 change_type change;
116 /* true if this widget itself has changed,
117 but not counting the other widgets found in the `next' field. */
118 change_type this_one_change;
119 #endif
120 /* Contents of the sub-widgets, also selected slot for checkbox */
121 struct _widget_value* contents;
122 /* data passed to callback */
123 XtPointer call_data;
124 /* next one in the list */
125 struct _widget_value* next;
126 #if 0
127 /* slot for the toolkit dependent part. Always initialize to NULL. */
128 void* toolkit_data;
129 /* tell us if we should free the toolkit data slot when freeing the
130 widget_value itself. */
131 Boolean free_toolkit_data;
133 /* we resource the widget_value structures; this points to the next
134 one on the free list if this one has been deallocated.
136 struct _widget_value *free_list;
137 #endif
138 } widget_value;
140 /* Assumed by other routines to zero area returned. */
141 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
142 0, (sizeof (widget_value)))
143 #define free_widget_value(wv) xfree (wv)
145 /******************************************************************/
147 #ifndef TRUE
148 #define TRUE 1
149 #define FALSE 0
150 #endif /* no TRUE */
152 Lisp_Object Vmenu_updating_frame;
154 Lisp_Object Qdebug_on_next_call;
156 extern Lisp_Object Qmenu_bar;
158 extern Lisp_Object QCtoggle, QCradio;
160 extern Lisp_Object Voverriding_local_map;
161 extern Lisp_Object Voverriding_local_map_menu_flag;
163 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
165 extern Lisp_Object Qmenu_bar_update_hook;
167 #if TARGET_API_MAC_CARBON
168 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
169 #else
170 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
171 #endif
173 void set_frame_menubar ();
175 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
176 Lisp_Object, Lisp_Object, Lisp_Object,
177 Lisp_Object, Lisp_Object));
178 #ifdef HAVE_DIALOGS
179 static Lisp_Object mac_dialog_show ();
180 #endif
181 static Lisp_Object mac_menu_show ();
183 static void keymap_panes ();
184 static void single_keymap_panes ();
185 static void single_menu_item ();
186 static void list_of_panes ();
187 static void list_of_items ();
189 static void fill_submenu (MenuHandle, widget_value *);
190 static void fill_menubar (widget_value *);
193 /* This holds a Lisp vector that holds the results of decoding
194 the keymaps or alist-of-alists that specify a menu.
196 It describes the panes and items within the panes.
198 Each pane is described by 3 elements in the vector:
199 t, the pane name, the pane's prefix key.
200 Then follow the pane's items, with 5 elements per item:
201 the item string, the enable flag, the item's value,
202 the definition, and the equivalent keyboard key's description string.
204 In some cases, multiple levels of menus may be described.
205 A single vector slot containing nil indicates the start of a submenu.
206 A single vector slot containing lambda indicates the end of a submenu.
207 The submenu follows a menu item which is the way to reach the submenu.
209 A single vector slot containing quote indicates that the
210 following items should appear on the right of a dialog box.
212 Using a Lisp vector to hold this information while we decode it
213 takes care of protecting all the data from GC. */
215 #define MENU_ITEMS_PANE_NAME 1
216 #define MENU_ITEMS_PANE_PREFIX 2
217 #define MENU_ITEMS_PANE_LENGTH 3
219 enum menu_item_idx
221 MENU_ITEMS_ITEM_NAME = 0,
222 MENU_ITEMS_ITEM_ENABLE,
223 MENU_ITEMS_ITEM_VALUE,
224 MENU_ITEMS_ITEM_EQUIV_KEY,
225 MENU_ITEMS_ITEM_DEFINITION,
226 MENU_ITEMS_ITEM_TYPE,
227 MENU_ITEMS_ITEM_SELECTED,
228 MENU_ITEMS_ITEM_HELP,
229 MENU_ITEMS_ITEM_LENGTH
232 static Lisp_Object menu_items;
234 /* Number of slots currently allocated in menu_items. */
235 static int menu_items_allocated;
237 /* This is the index in menu_items of the first empty slot. */
238 static int menu_items_used;
240 /* The number of panes currently recorded in menu_items,
241 excluding those within submenus. */
242 static int menu_items_n_panes;
244 /* Current depth within submenus. */
245 static int menu_items_submenu_depth;
247 /* Flag which when set indicates a dialog or menu has been posted by
248 Xt on behalf of one of the widget sets. */
249 static int popup_activated_flag;
251 /* Index of the next submenu */
252 static int submenu_id;
254 static int next_menubar_widget_id;
256 /* This is set nonzero after the user activates the menu bar, and set
257 to zero again after the menu bars are redisplayed by prepare_menu_bar.
258 While it is nonzero, all calls to set_frame_menubar go deep.
260 I don't understand why this is needed, but it does seem to be
261 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
263 int pending_menu_activation;
265 /* Initialize the menu_items structure if we haven't already done so.
266 Also mark it as currently empty. */
268 static void
269 init_menu_items ()
271 if (NILP (menu_items))
273 menu_items_allocated = 60;
274 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
277 menu_items_used = 0;
278 menu_items_n_panes = 0;
279 menu_items_submenu_depth = 0;
282 /* Call at the end of generating the data in menu_items.
283 This fills in the number of items in the last pane. */
285 static void
286 finish_menu_items ()
290 /* Call when finished using the data for the current menu
291 in menu_items. */
293 static void
294 discard_menu_items ()
296 /* Free the structure if it is especially large.
297 Otherwise, hold on to it, to save time. */
298 if (menu_items_allocated > 200)
300 menu_items = Qnil;
301 menu_items_allocated = 0;
305 /* Make the menu_items vector twice as large. */
307 static void
308 grow_menu_items ()
310 Lisp_Object old;
311 int old_size = menu_items_allocated;
312 old = menu_items;
314 menu_items_allocated *= 2;
315 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
316 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
317 old_size * sizeof (Lisp_Object));
320 /* Begin a submenu. */
322 static void
323 push_submenu_start ()
325 if (menu_items_used + 1 > menu_items_allocated)
326 grow_menu_items ();
328 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
329 menu_items_submenu_depth++;
332 /* End a submenu. */
334 static void
335 push_submenu_end ()
337 if (menu_items_used + 1 > menu_items_allocated)
338 grow_menu_items ();
340 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
341 menu_items_submenu_depth--;
344 /* Indicate boundary between left and right. */
346 static void
347 push_left_right_boundary ()
349 if (menu_items_used + 1 > menu_items_allocated)
350 grow_menu_items ();
352 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
355 /* Start a new menu pane in menu_items.
356 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
358 static void
359 push_menu_pane (name, prefix_vec)
360 Lisp_Object name, prefix_vec;
362 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
363 grow_menu_items ();
365 if (menu_items_submenu_depth == 0)
366 menu_items_n_panes++;
367 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
368 XVECTOR (menu_items)->contents[menu_items_used++] = name;
369 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
372 /* Push one menu item into the current pane. NAME is the string to
373 display. ENABLE if non-nil means this item can be selected. KEY
374 is the key generated by choosing this item, or nil if this item
375 doesn't really have a definition. DEF is the definition of this
376 item. EQUIV is the textual description of the keyboard equivalent
377 for this item (or nil if none). TYPE is the type of this menu
378 item, one of nil, `toggle' or `radio'. */
380 static void
381 push_menu_item (name, enable, key, def, equiv, type, selected, help)
382 Lisp_Object name, enable, key, def, equiv, type, selected, help;
384 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
385 grow_menu_items ();
387 XVECTOR (menu_items)->contents[menu_items_used++] = name;
388 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
389 XVECTOR (menu_items)->contents[menu_items_used++] = key;
390 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
391 XVECTOR (menu_items)->contents[menu_items_used++] = def;
392 XVECTOR (menu_items)->contents[menu_items_used++] = type;
393 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
394 XVECTOR (menu_items)->contents[menu_items_used++] = help;
397 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
398 and generate menu panes for them in menu_items.
399 If NOTREAL is nonzero,
400 don't bother really computing whether an item is enabled. */
402 static void
403 keymap_panes (keymaps, nmaps, notreal)
404 Lisp_Object *keymaps;
405 int nmaps;
406 int notreal;
408 int mapno;
410 init_menu_items ();
412 /* Loop over the given keymaps, making a pane for each map.
413 But don't make a pane that is empty--ignore that map instead.
414 P is the number of panes we have made so far. */
415 for (mapno = 0; mapno < nmaps; mapno++)
416 single_keymap_panes (keymaps[mapno],
417 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
419 finish_menu_items ();
422 /* This is a recursive subroutine of keymap_panes.
423 It handles one keymap, KEYMAP.
424 The other arguments are passed along
425 or point to local variables of the previous function.
426 If NOTREAL is nonzero, only check for equivalent key bindings, don't
427 evaluate expressions in menu items and don't make any menu.
429 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
431 static void
432 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
433 Lisp_Object keymap;
434 Lisp_Object pane_name;
435 Lisp_Object prefix;
436 int notreal;
437 int maxdepth;
439 Lisp_Object pending_maps = Qnil;
440 Lisp_Object tail, item;
441 struct gcpro gcpro1, gcpro2;
443 if (maxdepth <= 0)
444 return;
446 push_menu_pane (pane_name, prefix);
448 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
450 GCPRO2 (keymap, pending_maps);
451 /* Look at each key binding, and if it is a menu item add it
452 to this menu. */
453 item = XCAR (tail);
454 if (CONSP (item))
455 single_menu_item (XCAR (item), XCDR (item),
456 &pending_maps, notreal, maxdepth);
457 else if (VECTORP (item))
459 /* Loop over the char values represented in the vector. */
460 int len = XVECTOR (item)->size;
461 int c;
462 for (c = 0; c < len; c++)
464 Lisp_Object character;
465 XSETFASTINT (character, c);
466 single_menu_item (character, XVECTOR (item)->contents[c],
467 &pending_maps, notreal, maxdepth);
470 UNGCPRO;
473 /* Process now any submenus which want to be panes at this level. */
474 while (!NILP (pending_maps))
476 Lisp_Object elt, eltcdr, string;
477 elt = Fcar (pending_maps);
478 eltcdr = XCDR (elt);
479 string = XCAR (eltcdr);
480 /* We no longer discard the @ from the beginning of the string here.
481 Instead, we do this in mac_menu_show. */
482 single_keymap_panes (Fcar (elt), string,
483 XCDR (eltcdr), notreal, maxdepth - 1);
484 pending_maps = Fcdr (pending_maps);
488 /* This is a subroutine of single_keymap_panes that handles one
489 keymap entry.
490 KEY is a key in a keymap and ITEM is its binding.
491 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
492 separate panes.
493 If NOTREAL is nonzero, only check for equivalent key bindings, don't
494 evaluate expressions in menu items and don't make any menu.
495 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
497 static void
498 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
499 Lisp_Object key, item;
500 Lisp_Object *pending_maps_ptr;
501 int maxdepth, notreal;
503 Lisp_Object map, item_string, enabled;
504 struct gcpro gcpro1, gcpro2;
505 int res;
507 /* Parse the menu item and leave the result in item_properties. */
508 GCPRO2 (key, item);
509 res = parse_menu_item (item, notreal, 0);
510 UNGCPRO;
511 if (!res)
512 return; /* Not a menu item. */
514 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
516 if (notreal)
518 /* We don't want to make a menu, just traverse the keymaps to
519 precompute equivalent key bindings. */
520 if (!NILP (map))
521 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
522 return;
525 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
526 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
528 if (!NILP (map) && SREF (item_string, 0) == '@')
530 if (!NILP (enabled))
531 /* An enabled separate pane. Remember this to handle it later. */
532 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
533 *pending_maps_ptr);
534 return;
537 push_menu_item (item_string, enabled, key,
538 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
539 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
540 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
541 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
542 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
544 /* Display a submenu using the toolkit. */
545 if (! (NILP (map) || NILP (enabled)))
547 push_submenu_start ();
548 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
549 push_submenu_end ();
553 /* Push all the panes and items of a menu described by the
554 alist-of-alists MENU.
555 This handles old-fashioned calls to x-popup-menu. */
557 static void
558 list_of_panes (menu)
559 Lisp_Object menu;
561 Lisp_Object tail;
563 init_menu_items ();
565 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
567 Lisp_Object elt, pane_name, pane_data;
568 elt = Fcar (tail);
569 pane_name = Fcar (elt);
570 CHECK_STRING (pane_name);
571 push_menu_pane (pane_name, Qnil);
572 pane_data = Fcdr (elt);
573 CHECK_CONS (pane_data);
574 list_of_items (pane_data);
577 finish_menu_items ();
580 /* Push the items in a single pane defined by the alist PANE. */
582 static void
583 list_of_items (pane)
584 Lisp_Object pane;
586 Lisp_Object tail, item, item1;
588 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
590 item = Fcar (tail);
591 if (STRINGP (item))
592 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
593 else if (NILP (item))
594 push_left_right_boundary ();
595 else
597 CHECK_CONS (item);
598 item1 = Fcar (item);
599 CHECK_STRING (item1);
600 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
605 static Lisp_Object
606 cleanup_popup_menu (arg)
607 Lisp_Object arg;
609 discard_menu_items ();
612 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
613 doc: /* Pop up a deck-of-cards menu and return user's selection.
614 POSITION is a position specification. This is either a mouse button event
615 or a list ((XOFFSET YOFFSET) WINDOW)
616 where XOFFSET and YOFFSET are positions in pixels from the top left
617 corner of WINDOW. (WINDOW may be a window or a frame object.)
618 This controls the position of the top left of the menu as a whole.
619 If POSITION is t, it means to use the current mouse position.
621 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
622 The menu items come from key bindings that have a menu string as well as
623 a definition; actually, the "definition" in such a key binding looks like
624 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
625 the keymap as a top-level element.
627 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
628 Otherwise, REAL-DEFINITION should be a valid key binding definition.
630 You can also use a list of keymaps as MENU.
631 Then each keymap makes a separate pane.
633 When MENU is a keymap or a list of keymaps, the return value is the
634 list of events corresponding to the user's choice. Note that
635 `x-popup-menu' does not actually execute the command bound to that
636 sequence of events.
638 Alternatively, you can specify a menu of multiple panes
639 with a list of the form (TITLE PANE1 PANE2...),
640 where each pane is a list of form (TITLE ITEM1 ITEM2...).
641 Each ITEM is normally a cons cell (STRING . VALUE);
642 but a string can appear as an item--that makes a nonselectable line
643 in the menu.
644 With this form of menu, the return value is VALUE from the chosen item.
646 If POSITION is nil, don't display the menu at all, just precalculate the
647 cached information about equivalent key sequences.
649 If the user gets rid of the menu without making a valid choice, for
650 instance by clicking the mouse away from a valid choice or by typing
651 keyboard input, then this normally results in a quit and
652 `x-popup-menu' does not return. But if POSITION is a mouse button
653 event (indicating that the user invoked the menu with the mouse) then
654 no quit occurs and `x-popup-menu' returns nil. */)
655 (position, menu)
656 Lisp_Object position, menu;
658 Lisp_Object keymap, tem;
659 int xpos = 0, ypos = 0;
660 Lisp_Object title;
661 char *error_name;
662 Lisp_Object selection;
663 FRAME_PTR f = NULL;
664 Lisp_Object x, y, window;
665 int keymaps = 0;
666 int for_click = 0;
667 struct gcpro gcpro1;
668 int specpdl_count = SPECPDL_INDEX ();
671 #ifdef HAVE_MENUS
672 if (! NILP (position))
674 check_mac ();
676 /* Decode the first argument: find the window and the coordinates. */
677 if (EQ (position, Qt)
678 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
679 || EQ (XCAR (position), Qtool_bar))))
681 /* Use the mouse's current position. */
682 FRAME_PTR new_f = SELECTED_FRAME ();
683 Lisp_Object bar_window;
684 enum scroll_bar_part part;
685 unsigned long time;
687 if (mouse_position_hook)
688 (*mouse_position_hook) (&new_f, 1, &bar_window,
689 &part, &x, &y, &time);
690 if (new_f != 0)
691 XSETFRAME (window, new_f);
692 else
694 window = selected_window;
695 XSETFASTINT (x, 0);
696 XSETFASTINT (y, 0);
699 else
701 tem = Fcar (position);
702 if (CONSP (tem))
704 window = Fcar (Fcdr (position));
705 x = Fcar (tem);
706 y = Fcar (Fcdr (tem));
708 else
710 for_click = 1;
711 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
712 window = Fcar (tem); /* POSN_WINDOW (tem) */
713 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
714 x = Fcar (tem);
715 y = Fcdr (tem);
719 CHECK_NUMBER (x);
720 CHECK_NUMBER (y);
722 /* Decode where to put the menu. */
724 if (FRAMEP (window))
726 f = XFRAME (window);
727 xpos = 0;
728 ypos = 0;
730 else if (WINDOWP (window))
732 CHECK_LIVE_WINDOW (window);
733 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
735 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
736 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
738 else
739 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
740 but I don't want to make one now. */
741 CHECK_WINDOW (window);
743 xpos += XINT (x);
744 ypos += XINT (y);
746 XSETFRAME (Vmenu_updating_frame, f);
748 Vmenu_updating_frame = Qnil;
749 #endif /* HAVE_MENUS */
751 title = Qnil;
752 GCPRO1 (title);
754 /* Decode the menu items from what was specified. */
756 keymap = get_keymap (menu, 0, 0);
757 if (CONSP (keymap))
759 /* We were given a keymap. Extract menu info from the keymap. */
760 Lisp_Object prompt;
762 /* Extract the detailed info to make one pane. */
763 keymap_panes (&menu, 1, NILP (position));
765 /* Search for a string appearing directly as an element of the keymap.
766 That string is the title of the menu. */
767 prompt = Fkeymap_prompt (keymap);
768 if (NILP (title) && !NILP (prompt))
769 title = prompt;
771 /* Make that be the pane title of the first pane. */
772 if (!NILP (prompt) && menu_items_n_panes >= 0)
773 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
775 keymaps = 1;
777 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
779 /* We were given a list of keymaps. */
780 int nmaps = XFASTINT (Flength (menu));
781 Lisp_Object *maps
782 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
783 int i;
785 title = Qnil;
787 /* The first keymap that has a prompt string
788 supplies the menu title. */
789 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
791 Lisp_Object prompt;
793 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
795 prompt = Fkeymap_prompt (keymap);
796 if (NILP (title) && !NILP (prompt))
797 title = prompt;
800 /* Extract the detailed info to make one pane. */
801 keymap_panes (maps, nmaps, NILP (position));
803 /* Make the title be the pane title of the first pane. */
804 if (!NILP (title) && menu_items_n_panes >= 0)
805 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
807 keymaps = 1;
809 else
811 /* We were given an old-fashioned menu. */
812 title = Fcar (menu);
813 CHECK_STRING (title);
815 list_of_panes (Fcdr (menu));
817 keymaps = 0;
820 if (NILP (position))
822 discard_menu_items ();
823 UNGCPRO;
824 return Qnil;
827 #ifdef HAVE_MENUS
828 /* Display them in a menu. */
829 record_unwind_protect (cleanup_popup_menu, Qnil);
830 BLOCK_INPUT;
832 selection = mac_menu_show (f, xpos, ypos, for_click,
833 keymaps, title, &error_name);
834 UNBLOCK_INPUT;
835 unbind_to (specpdl_count, Qnil);
837 UNGCPRO;
838 #endif /* HAVE_MENUS */
840 if (error_name) error (error_name);
841 return selection;
844 #ifdef HAVE_MENUS
846 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
847 doc: /* Pop up a dialog box and return user's selection.
848 POSITION specifies which frame to use.
849 This is normally a mouse button event or a window or frame.
850 If POSITION is t, it means to use the frame the mouse is on.
851 The dialog box appears in the middle of the specified frame.
853 CONTENTS specifies the alternatives to display in the dialog box.
854 It is a list of the form (DIALOG ITEM1 ITEM2...).
855 Each ITEM is a cons cell (STRING . VALUE).
856 The return value is VALUE from the chosen item.
858 An ITEM may also be just a string--that makes a nonselectable item.
859 An ITEM may also be nil--that means to put all preceding items
860 on the left of the dialog box and all following items on the right.
861 \(By default, approximately half appear on each side.)
863 If HEADER is non-nil, the frame title for the box is "Information",
864 otherwise it is "Question".
866 If the user gets rid of the dialog box without making a valid choice,
867 for instance using the window manager, then this produces a quit and
868 `x-popup-dialog' does not return. */)
869 (position, contents, header)
870 Lisp_Object position, contents, header;
872 FRAME_PTR f = NULL;
873 Lisp_Object window;
875 check_mac ();
877 /* Decode the first argument: find the window or frame to use. */
878 if (EQ (position, Qt)
879 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
880 || EQ (XCAR (position), Qtool_bar))))
882 #if 0 /* Using the frame the mouse is on may not be right. */
883 /* Use the mouse's current position. */
884 FRAME_PTR new_f = SELECTED_FRAME ();
885 Lisp_Object bar_window;
886 enum scroll_bar_part part;
887 unsigned long time;
888 Lisp_Object x, y;
890 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
892 if (new_f != 0)
893 XSETFRAME (window, new_f);
894 else
895 window = selected_window;
896 #endif
897 window = selected_window;
899 else if (CONSP (position))
901 Lisp_Object tem;
902 tem = Fcar (position);
903 if (CONSP (tem))
904 window = Fcar (Fcdr (position));
905 else
907 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
908 window = Fcar (tem); /* POSN_WINDOW (tem) */
911 else if (WINDOWP (position) || FRAMEP (position))
912 window = position;
913 else
914 window = Qnil;
916 /* Decode where to put the menu. */
918 if (FRAMEP (window))
919 f = XFRAME (window);
920 else if (WINDOWP (window))
922 CHECK_LIVE_WINDOW (window);
923 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
925 else
926 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
927 but I don't want to make one now. */
928 CHECK_WINDOW (window);
930 #ifndef HAVE_DIALOGS
931 /* Display a menu with these alternatives
932 in the middle of frame F. */
934 Lisp_Object x, y, frame, newpos;
935 XSETFRAME (frame, f);
936 XSETINT (x, x_pixel_width (f) / 2);
937 XSETINT (y, x_pixel_height (f) / 2);
938 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
940 return Fx_popup_menu (newpos,
941 Fcons (Fcar (contents), Fcons (contents, Qnil)));
943 #else /* HAVE_DIALOGS */
945 Lisp_Object title;
946 char *error_name;
947 Lisp_Object selection;
949 /* Decode the dialog items from what was specified. */
950 title = Fcar (contents);
951 CHECK_STRING (title);
953 list_of_panes (Fcons (contents, Qnil));
955 /* Display them in a dialog box. */
956 BLOCK_INPUT;
957 selection = mac_dialog_show (f, 0, title, header, &error_name);
958 UNBLOCK_INPUT;
960 discard_menu_items ();
962 if (error_name) error (error_name);
963 return selection;
965 #endif /* HAVE_DIALOGS */
968 /* Activate the menu bar of frame F.
969 This is called from keyboard.c when it gets the
970 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
972 To activate the menu bar, we signal to the input thread that it can
973 return from the WM_INITMENU message, allowing the normal Windows
974 processing of the menus.
976 But first we recompute the menu bar contents (the whole tree).
978 This way we can safely 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->menu_command_in_progress = 0;
1076 f->output_data.mac->menubar_active = 0;
1077 return;
1079 i += MENU_ITEMS_ITEM_LENGTH;
1082 f->output_data.mac->menu_command_in_progress = 0;
1083 f->output_data.mac->menubar_active = 0;
1086 /* Allocate a widget_value, blocking input. */
1088 widget_value *
1089 xmalloc_widget_value ()
1091 widget_value *value;
1093 BLOCK_INPUT;
1094 value = malloc_widget_value ();
1095 UNBLOCK_INPUT;
1097 return value;
1100 /* This recursively calls free_widget_value on the tree of widgets.
1101 It must free all data that was malloc'ed for these widget_values.
1102 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1103 must be left alone. */
1105 void
1106 free_menubar_widget_value_tree (wv)
1107 widget_value *wv;
1109 if (! wv) return;
1111 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1113 if (wv->contents && (wv->contents != (widget_value*)1))
1115 free_menubar_widget_value_tree (wv->contents);
1116 wv->contents = (widget_value *) 0xDEADBEEF;
1118 if (wv->next)
1120 free_menubar_widget_value_tree (wv->next);
1121 wv->next = (widget_value *) 0xDEADBEEF;
1123 BLOCK_INPUT;
1124 free_widget_value (wv);
1125 UNBLOCK_INPUT;
1128 /* Return a tree of widget_value structures for a menu bar item
1129 whose event type is ITEM_KEY (with string ITEM_NAME)
1130 and whose contents come from the list of keymaps MAPS. */
1132 static widget_value *
1133 single_submenu (item_key, item_name, maps)
1134 Lisp_Object item_key, item_name, maps;
1136 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1137 int i;
1138 int submenu_depth = 0;
1139 Lisp_Object length;
1140 int len;
1141 Lisp_Object *mapvec;
1142 widget_value **submenu_stack;
1143 int previous_items = menu_items_used;
1144 int top_level_items = 0;
1146 length = Flength (maps);
1147 len = XINT (length);
1149 /* Convert the list MAPS into a vector MAPVEC. */
1150 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1151 for (i = 0; i < len; i++)
1153 mapvec[i] = Fcar (maps);
1154 maps = Fcdr (maps);
1157 menu_items_n_panes = 0;
1159 /* Loop over the given keymaps, making a pane for each map.
1160 But don't make a pane that is empty--ignore that map instead. */
1161 for (i = 0; i < len; i++)
1163 if (SYMBOLP (mapvec[i])
1164 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1166 /* Here we have a command at top level in the menu bar
1167 as opposed to a submenu. */
1168 top_level_items = 1;
1169 push_menu_pane (Qnil, Qnil);
1170 push_menu_item (item_name, Qt, item_key, mapvec[i],
1171 Qnil, Qnil, Qnil, Qnil);
1173 else
1174 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1177 /* Create a tree of widget_value objects
1178 representing the panes and their items. */
1180 submenu_stack
1181 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1182 wv = xmalloc_widget_value ();
1183 wv->name = "menu";
1184 wv->value = 0;
1185 wv->enabled = 1;
1186 wv->button_type = BUTTON_TYPE_NONE;
1187 wv->help = Qnil;
1188 first_wv = wv;
1189 save_wv = 0;
1190 prev_wv = 0;
1192 /* Loop over all panes and items made during this call
1193 and construct a tree of widget_value objects.
1194 Ignore the panes and items made by previous calls to
1195 single_submenu, even though those are also in menu_items. */
1196 i = previous_items;
1197 while (i < menu_items_used)
1199 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1201 submenu_stack[submenu_depth++] = save_wv;
1202 save_wv = prev_wv;
1203 prev_wv = 0;
1204 i++;
1206 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1208 prev_wv = save_wv;
1209 save_wv = submenu_stack[--submenu_depth];
1210 i++;
1212 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1213 && submenu_depth != 0)
1214 i += MENU_ITEMS_PANE_LENGTH;
1215 /* Ignore a nil in the item list.
1216 It's meaningful only for dialog boxes. */
1217 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1218 i += 1;
1219 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1221 /* Create a new pane. */
1222 Lisp_Object pane_name, prefix;
1223 char *pane_string;
1225 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1226 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1228 #ifndef HAVE_MULTILINGUAL_MENU
1229 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1231 pane_name = ENCODE_SYSTEM (pane_name);
1232 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1234 #endif
1235 pane_string = (NILP (pane_name)
1236 ? "" : (char *) SDATA (pane_name));
1237 /* If there is just one top-level pane, put all its items directly
1238 under the top-level menu. */
1239 if (menu_items_n_panes == 1)
1240 pane_string = "";
1242 /* If the pane has a meaningful name,
1243 make the pane a top-level menu item
1244 with its items as a submenu beneath it. */
1245 if (strcmp (pane_string, ""))
1247 wv = xmalloc_widget_value ();
1248 if (save_wv)
1249 save_wv->next = wv;
1250 else
1251 first_wv->contents = wv;
1252 wv->lname = pane_name;
1253 /* Set value to 1 so update_submenu_strings can handle '@' */
1254 wv->value = (char *)1;
1255 wv->enabled = 1;
1256 wv->button_type = BUTTON_TYPE_NONE;
1257 wv->help = Qnil;
1259 save_wv = wv;
1260 prev_wv = 0;
1261 i += MENU_ITEMS_PANE_LENGTH;
1263 else
1265 /* Create a new item within current pane. */
1266 Lisp_Object item_name, enable, descrip, def, type, selected;
1267 Lisp_Object help;
1269 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1270 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1271 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1272 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1273 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1274 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1275 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1277 #ifndef HAVE_MULTILINGUAL_MENU
1278 if (STRING_MULTIBYTE (item_name))
1280 item_name = ENCODE_MENU_STRING (item_name);
1281 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1284 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1286 descrip = ENCODE_MENU_STRING (descrip);
1287 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1289 #endif /* not HAVE_MULTILINGUAL_MENU */
1291 wv = xmalloc_widget_value ();
1292 if (prev_wv)
1293 prev_wv->next = wv;
1294 else
1295 save_wv->contents = wv;
1297 wv->lname = item_name;
1298 if (!NILP (descrip))
1299 wv->lkey = descrip;
1300 wv->value = 0;
1301 /* The EMACS_INT cast avoids a warning. There's no problem
1302 as long as pointers have enough bits to hold small integers. */
1303 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1304 wv->enabled = !NILP (enable);
1306 if (NILP (type))
1307 wv->button_type = BUTTON_TYPE_NONE;
1308 else if (EQ (type, QCradio))
1309 wv->button_type = BUTTON_TYPE_RADIO;
1310 else if (EQ (type, QCtoggle))
1311 wv->button_type = BUTTON_TYPE_TOGGLE;
1312 else
1313 abort ();
1315 wv->selected = !NILP (selected);
1316 if (!STRINGP (help))
1317 help = Qnil;
1319 wv->help = help;
1321 prev_wv = wv;
1323 i += MENU_ITEMS_ITEM_LENGTH;
1327 /* If we have just one "menu item"
1328 that was originally a button, return it by itself. */
1329 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1331 wv = first_wv->contents;
1332 free_widget_value (first_wv);
1333 return wv;
1336 return first_wv;
1338 /* Walk through the widget_value tree starting at FIRST_WV and update
1339 the char * pointers from the corresponding lisp values.
1340 We do this after building the whole tree, since GC may happen while the
1341 tree is constructed, and small strings are relocated. So we must wait
1342 until no GC can happen before storing pointers into lisp values. */
1343 static void
1344 update_submenu_strings (first_wv)
1345 widget_value *first_wv;
1347 widget_value *wv;
1349 for (wv = first_wv; wv; wv = wv->next)
1351 if (STRINGP (wv->lname))
1353 wv->name = SDATA (wv->lname);
1355 /* Ignore the @ that means "separate pane".
1356 This is a kludge, but this isn't worth more time. */
1357 if (wv->value == (char *)1)
1359 if (wv->name[0] == '@')
1360 wv->name++;
1361 wv->value = 0;
1365 if (STRINGP (wv->lkey))
1366 wv->key = SDATA (wv->lkey);
1368 if (wv->contents)
1369 update_submenu_strings (wv->contents);
1374 /* Event handler function that pops down a menu on C-g. We can only pop
1375 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1377 #ifdef HAVE_CANCELMENUTRACKING
1378 static pascal OSStatus
1379 menu_quit_handler (nextHandler, theEvent, userData)
1380 EventHandlerCallRef nextHandler;
1381 EventRef theEvent;
1382 void* userData;
1384 UInt32 keyCode;
1385 UInt32 keyModifiers;
1386 extern int mac_quit_char_modifiers;
1387 extern int mac_quit_char_keycode;
1389 GetEventParameter (theEvent, kEventParamKeyCode,
1390 typeUInt32, NULL, sizeof(UInt32), NULL, &keyCode);
1392 GetEventParameter (theEvent, kEventParamKeyModifiers,
1393 typeUInt32, NULL, sizeof(UInt32),
1394 NULL, &keyModifiers);
1396 if (keyCode == mac_quit_char_keycode
1397 && keyModifiers == mac_quit_char_modifiers)
1399 MenuRef menu = userData != 0
1400 ? (MenuRef)userData : AcquireRootMenu ();
1402 CancelMenuTracking (menu, true, 0);
1403 if (!userData) ReleaseMenu (menu);
1404 return noErr;
1407 return CallNextEventHandler (nextHandler, theEvent);
1409 #endif /* HAVE_CANCELMENUTRACKING */
1411 /* Add event handler for MENU_HANDLE so we can detect C-g.
1412 If MENU_HANDLE is NULL, install handler for all menus in the menu bar.
1413 If CancelMenuTracking isn't available, do nothing. */
1415 static void
1416 install_menu_quit_handler (MenuHandle menu_handle)
1418 #ifdef HAVE_CANCELMENUTRACKING
1419 EventHandlerUPP handler = NewEventHandlerUPP(menu_quit_handler);
1420 UInt32 numTypes = 1;
1421 EventTypeSpec typesList[] = { { kEventClassKeyboard, kEventRawKeyDown } };
1422 int i = MIN_MENU_ID;
1423 MenuHandle menu = menu_handle ? menu_handle : GetMenuHandle (i);
1425 while (menu != NULL)
1427 InstallMenuEventHandler (menu, handler, GetEventTypeCount (typesList),
1428 typesList, menu_handle, NULL);
1429 if (menu_handle) break;
1430 menu = GetMenuHandle (++i);
1432 DisposeEventHandlerUPP (handler);
1433 #endif /* HAVE_CANCELMENUTRACKING */
1436 /* Set the contents of the menubar widgets of frame F.
1437 The argument FIRST_TIME is currently ignored;
1438 it is set the first time this is called, from initialize_frame_menubar. */
1440 void
1441 set_frame_menubar (f, first_time, deep_p)
1442 FRAME_PTR f;
1443 int first_time;
1444 int deep_p;
1446 int menubar_widget = f->output_data.mac->menubar_widget;
1447 Lisp_Object items;
1448 widget_value *wv, *first_wv, *prev_wv = 0;
1449 int i;
1451 /* We must not change the menubar when actually in use. */
1452 if (f->output_data.mac->menubar_active)
1453 return;
1455 XSETFRAME (Vmenu_updating_frame, f);
1457 if (! menubar_widget)
1458 deep_p = 1;
1459 else if (pending_menu_activation && !deep_p)
1460 deep_p = 1;
1462 wv = xmalloc_widget_value ();
1463 wv->name = "menubar";
1464 wv->value = 0;
1465 wv->enabled = 1;
1466 wv->button_type = BUTTON_TYPE_NONE;
1467 wv->help = Qnil;
1468 first_wv = wv;
1470 if (deep_p)
1472 /* Make a widget-value tree representing the entire menu trees. */
1474 struct buffer *prev = current_buffer;
1475 Lisp_Object buffer;
1476 int specpdl_count = SPECPDL_INDEX ();
1477 int previous_menu_items_used = f->menu_bar_items_used;
1478 Lisp_Object *previous_items
1479 = (Lisp_Object *) alloca (previous_menu_items_used
1480 * sizeof (Lisp_Object));
1482 /* If we are making a new widget, its contents are empty,
1483 do always reinitialize them. */
1484 if (! menubar_widget)
1485 previous_menu_items_used = 0;
1487 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1488 specbind (Qinhibit_quit, Qt);
1489 /* Don't let the debugger step into this code
1490 because it is not reentrant. */
1491 specbind (Qdebug_on_next_call, Qnil);
1493 record_unwind_save_match_data ();
1494 if (NILP (Voverriding_local_map_menu_flag))
1496 specbind (Qoverriding_terminal_local_map, Qnil);
1497 specbind (Qoverriding_local_map, Qnil);
1500 set_buffer_internal_1 (XBUFFER (buffer));
1502 /* Run the Lucid hook. */
1503 safe_run_hooks (Qactivate_menubar_hook);
1504 /* If it has changed current-menubar from previous value,
1505 really recompute the menubar from the value. */
1506 if (! NILP (Vlucid_menu_bar_dirty_flag))
1507 call0 (Qrecompute_lucid_menubar);
1508 safe_run_hooks (Qmenu_bar_update_hook);
1509 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1511 items = FRAME_MENU_BAR_ITEMS (f);
1513 /* Save the frame's previous menu bar contents data. */
1514 if (previous_menu_items_used)
1515 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1516 previous_menu_items_used * sizeof (Lisp_Object));
1518 /* Fill in the current menu bar contents. */
1519 menu_items = f->menu_bar_vector;
1520 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1521 init_menu_items ();
1522 for (i = 0; i < XVECTOR (items)->size; i += 4)
1524 Lisp_Object key, string, maps;
1526 key = XVECTOR (items)->contents[i];
1527 string = XVECTOR (items)->contents[i + 1];
1528 maps = XVECTOR (items)->contents[i + 2];
1529 if (NILP (string))
1530 break;
1532 wv = single_submenu (key, string, maps);
1533 if (prev_wv)
1534 prev_wv->next = wv;
1535 else
1536 first_wv->contents = wv;
1537 /* Don't set wv->name here; GC during the loop might relocate it. */
1538 wv->enabled = 1;
1539 wv->button_type = BUTTON_TYPE_NONE;
1540 prev_wv = wv;
1543 finish_menu_items ();
1545 set_buffer_internal_1 (prev);
1546 unbind_to (specpdl_count, Qnil);
1548 /* If there has been no change in the Lisp-level contents
1549 of the menu bar, skip redisplaying it. Just exit. */
1551 for (i = 0; i < previous_menu_items_used; i++)
1552 if (menu_items_used == i
1553 || (NILP (Fequal (previous_items[i],
1554 XVECTOR (menu_items)->contents[i]))))
1555 break;
1556 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1558 free_menubar_widget_value_tree (first_wv);
1559 menu_items = Qnil;
1561 return;
1564 /* Now GC cannot happen during the lifetime of the widget_value,
1565 so it's safe to store data from a Lisp_String, as long as
1566 local copies are made when the actual menu is created.
1567 Windows takes care of this for normal string items, but
1568 not for owner-drawn items or additional item-info. */
1569 wv = first_wv->contents;
1570 for (i = 0; i < XVECTOR (items)->size; i += 4)
1572 Lisp_Object string;
1573 string = XVECTOR (items)->contents[i + 1];
1574 if (NILP (string))
1575 break;
1576 wv->name = (char *) SDATA (string);
1577 update_submenu_strings (wv->contents);
1578 wv = wv->next;
1581 f->menu_bar_vector = menu_items;
1582 f->menu_bar_items_used = menu_items_used;
1583 menu_items = Qnil;
1585 else
1587 /* Make a widget-value tree containing
1588 just the top level menu bar strings. */
1590 items = FRAME_MENU_BAR_ITEMS (f);
1591 for (i = 0; i < XVECTOR (items)->size; i += 4)
1593 Lisp_Object string;
1595 string = XVECTOR (items)->contents[i + 1];
1596 if (NILP (string))
1597 break;
1599 wv = xmalloc_widget_value ();
1600 wv->name = (char *) SDATA (string);
1601 wv->value = 0;
1602 wv->enabled = 1;
1603 wv->button_type = BUTTON_TYPE_NONE;
1604 wv->help = Qnil;
1605 /* This prevents lwlib from assuming this
1606 menu item is really supposed to be empty. */
1607 /* The EMACS_INT cast avoids a warning.
1608 This value just has to be different from small integers. */
1609 wv->call_data = (void *) (EMACS_INT) (-1);
1611 if (prev_wv)
1612 prev_wv->next = wv;
1613 else
1614 first_wv->contents = wv;
1615 prev_wv = wv;
1618 /* Forget what we thought we knew about what is in the
1619 detailed contents of the menu bar menus.
1620 Changing the top level always destroys the contents. */
1621 f->menu_bar_items_used = 0;
1624 /* Create or update the menu bar widget. */
1626 BLOCK_INPUT;
1628 /* Non-null value to indicate menubar has already been "created". */
1629 f->output_data.mac->menubar_widget = 1;
1632 int i = MIN_MENU_ID;
1633 MenuHandle menu = GetMenuHandle (i);
1634 while (menu != NULL)
1636 DeleteMenu (i);
1637 DisposeMenu (menu);
1638 menu = GetMenuHandle (++i);
1641 i = MIN_SUBMENU_ID;
1642 menu = GetMenuHandle (i);
1643 while (menu != NULL)
1645 DeleteMenu (i);
1646 DisposeMenu (menu);
1647 menu = GetMenuHandle (++i);
1651 fill_menubar (first_wv->contents);
1653 DrawMenuBar ();
1655 /* Add event handler so we can detect C-g. */
1656 install_menu_quit_handler (NULL);
1657 free_menubar_widget_value_tree (first_wv);
1659 UNBLOCK_INPUT;
1662 /* Called from Fx_create_frame to create the initial menubar of a frame
1663 before it is mapped, so that the window is mapped with the menubar already
1664 there instead of us tacking it on later and thrashing the window after it
1665 is visible. */
1667 void
1668 initialize_frame_menubar (f)
1669 FRAME_PTR f;
1671 /* This function is called before the first chance to redisplay
1672 the frame. It has to be, so the frame will have the right size. */
1673 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1674 set_frame_menubar (f, 1, 1);
1677 /* Get rid of the menu bar of frame F, and free its storage.
1678 This is used when deleting a frame, and when turning off the menu bar. */
1680 void
1681 free_frame_menubar (f)
1682 FRAME_PTR f;
1684 f->output_data.mac->menubar_widget = NULL;
1688 static Lisp_Object
1689 pop_down_menu (arg)
1690 Lisp_Object arg;
1692 struct Lisp_Save_Value *p1 = XSAVE_VALUE (Fcar (arg));
1693 struct Lisp_Save_Value *p2 = XSAVE_VALUE (Fcdr (arg));
1695 FRAME_PTR f = p1->pointer;
1696 MenuHandle *menu = p2->pointer;
1698 BLOCK_INPUT;
1700 /* Must reset this manually because the button release event is not
1701 passed to Emacs event loop. */
1702 FRAME_MAC_DISPLAY_INFO (f)->grabbed = 0;
1704 /* delete all menus */
1706 int i = MIN_POPUP_SUBMENU_ID;
1707 MenuHandle submenu = GetMenuHandle (i);
1708 while (submenu != NULL)
1710 DeleteMenu (i);
1711 DisposeMenu (submenu);
1712 submenu = GetMenuHandle (++i);
1716 DeleteMenu (POPUP_SUBMENU_ID);
1717 DisposeMenu (*menu);
1719 UNBLOCK_INPUT;
1721 return Qnil;
1724 /* Mac_menu_show actually displays a menu using the panes and items in
1725 menu_items and returns the value selected from it; we assume input
1726 is blocked by the caller. */
1728 /* F is the frame the menu is for.
1729 X and Y are the frame-relative specified position,
1730 relative to the inside upper left corner of the frame F.
1731 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1732 KEYMAPS is 1 if this menu was specified with keymaps;
1733 in that case, we return a list containing the chosen item's value
1734 and perhaps also the pane's prefix.
1735 TITLE is the specified menu title.
1736 ERROR is a place to store an error message string in case of failure.
1737 (We return nil on failure, but the value doesn't actually matter.) */
1739 static Lisp_Object
1740 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1741 FRAME_PTR f;
1742 int x;
1743 int y;
1744 int for_click;
1745 int keymaps;
1746 Lisp_Object title;
1747 char **error;
1749 int i;
1750 UInt32 refcon;
1751 int menu_item_choice;
1752 int menu_item_selection;
1753 MenuHandle menu;
1754 Point pos;
1755 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1756 widget_value **submenu_stack
1757 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1758 Lisp_Object *subprefix_stack
1759 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1760 int submenu_depth = 0;
1761 int first_pane;
1762 int specpdl_count = SPECPDL_INDEX ();
1764 *error = NULL;
1766 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1768 *error = "Empty menu";
1769 return Qnil;
1772 /* Create a tree of widget_value objects
1773 representing the panes and their items. */
1774 wv = xmalloc_widget_value ();
1775 wv->name = "menu";
1776 wv->value = 0;
1777 wv->enabled = 1;
1778 wv->button_type = BUTTON_TYPE_NONE;
1779 wv->help = Qnil;
1780 first_wv = wv;
1781 first_pane = 1;
1783 /* Loop over all panes and items, filling in the tree. */
1784 i = 0;
1785 while (i < menu_items_used)
1787 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1789 submenu_stack[submenu_depth++] = save_wv;
1790 save_wv = prev_wv;
1791 prev_wv = 0;
1792 first_pane = 1;
1793 i++;
1795 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1797 prev_wv = save_wv;
1798 save_wv = submenu_stack[--submenu_depth];
1799 first_pane = 0;
1800 i++;
1802 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1803 && submenu_depth != 0)
1804 i += MENU_ITEMS_PANE_LENGTH;
1805 /* Ignore a nil in the item list.
1806 It's meaningful only for dialog boxes. */
1807 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1808 i += 1;
1809 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1811 /* Create a new pane. */
1812 Lisp_Object pane_name, prefix;
1813 char *pane_string;
1814 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1815 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1816 #ifndef HAVE_MULTILINGUAL_MENU
1817 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1819 pane_name = ENCODE_SYSTEM (pane_name);
1820 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1822 #endif
1823 pane_string = (NILP (pane_name)
1824 ? "" : (char *) SDATA (pane_name));
1825 /* If there is just one top-level pane, put all its items directly
1826 under the top-level menu. */
1827 if (menu_items_n_panes == 1)
1828 pane_string = "";
1830 /* If the pane has a meaningful name,
1831 make the pane a top-level menu item
1832 with its items as a submenu beneath it. */
1833 if (!keymaps && strcmp (pane_string, ""))
1835 wv = xmalloc_widget_value ();
1836 if (save_wv)
1837 save_wv->next = wv;
1838 else
1839 first_wv->contents = wv;
1840 wv->name = pane_string;
1841 if (keymaps && !NILP (prefix))
1842 wv->name++;
1843 wv->value = 0;
1844 wv->enabled = 1;
1845 wv->button_type = BUTTON_TYPE_NONE;
1846 wv->help = Qnil;
1847 save_wv = wv;
1848 prev_wv = 0;
1850 else if (first_pane)
1852 save_wv = wv;
1853 prev_wv = 0;
1855 first_pane = 0;
1856 i += MENU_ITEMS_PANE_LENGTH;
1858 else
1860 /* Create a new item within current pane. */
1861 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1863 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1864 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1865 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1866 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1867 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1868 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1869 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1871 #ifndef HAVE_MULTILINGUAL_MENU
1872 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1874 item_name = ENCODE_MENU_STRING (item_name);
1875 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1877 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1879 descrip = ENCODE_MENU_STRING (descrip);
1880 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1882 #endif /* not HAVE_MULTILINGUAL_MENU */
1884 wv = xmalloc_widget_value ();
1885 if (prev_wv)
1886 prev_wv->next = wv;
1887 else
1888 save_wv->contents = wv;
1889 wv->name = (char *) SDATA (item_name);
1890 if (!NILP (descrip))
1891 wv->key = (char *) SDATA (descrip);
1892 wv->value = 0;
1893 /* Use the contents index as call_data, since we are
1894 restricted to 16-bits. */
1895 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1896 wv->enabled = !NILP (enable);
1898 if (NILP (type))
1899 wv->button_type = BUTTON_TYPE_NONE;
1900 else if (EQ (type, QCtoggle))
1901 wv->button_type = BUTTON_TYPE_TOGGLE;
1902 else if (EQ (type, QCradio))
1903 wv->button_type = BUTTON_TYPE_RADIO;
1904 else
1905 abort ();
1907 wv->selected = !NILP (selected);
1908 if (!STRINGP (help))
1909 help = Qnil;
1911 wv->help = help;
1913 prev_wv = wv;
1915 i += MENU_ITEMS_ITEM_LENGTH;
1919 /* Deal with the title, if it is non-nil. */
1920 if (!NILP (title))
1922 widget_value *wv_title = xmalloc_widget_value ();
1923 widget_value *wv_sep = xmalloc_widget_value ();
1925 /* Maybe replace this separator with a bitmap or owner-draw item
1926 so that it looks better. Having two separators looks odd. */
1927 wv_sep->name = "--";
1928 wv_sep->next = first_wv->contents;
1929 wv_sep->help = Qnil;
1931 #ifndef HAVE_MULTILINGUAL_MENU
1932 if (STRING_MULTIBYTE (title))
1933 title = ENCODE_MENU_STRING (title);
1934 #endif
1935 wv_title->name = (char *) SDATA (title);
1936 wv_title->enabled = FALSE;
1937 wv_title->title = TRUE;
1938 wv_title->button_type = BUTTON_TYPE_NONE;
1939 wv_title->help = Qnil;
1940 wv_title->next = wv_sep;
1941 first_wv->contents = wv_title;
1944 /* Actually create the menu. */
1945 menu = NewMenu (POPUP_SUBMENU_ID, "\p");
1946 submenu_id = MIN_POPUP_SUBMENU_ID;
1947 fill_submenu (menu, first_wv->contents);
1949 /* Free the widget_value objects we used to specify the
1950 contents. */
1951 free_menubar_widget_value_tree (first_wv);
1953 /* Adjust coordinates to be root-window-relative. */
1954 pos.h = x;
1955 pos.v = y;
1957 SetPortWindowPort (FRAME_MAC_WINDOW (f));
1959 LocalToGlobal (&pos);
1961 /* No selection has been chosen yet. */
1962 menu_item_choice = 0;
1963 menu_item_selection = 0;
1965 InsertMenu (menu, -1);
1967 record_unwind_protect (pop_down_menu,
1968 Fcons (make_save_value (f, 0),
1969 make_save_value (&menu, 0)));
1971 /* Add event handler so we can detect C-g. */
1972 install_menu_quit_handler (menu);
1974 /* Display the menu. */
1975 menu_item_choice = PopUpMenuSelect (menu, pos.v, pos.h, 0);
1976 menu_item_selection = LoWord (menu_item_choice);
1978 /* Get the refcon to find the correct item */
1979 if (menu_item_selection)
1981 MenuHandle sel_menu = GetMenuHandle (HiWord (menu_item_choice));
1982 if (sel_menu) {
1983 GetMenuItemRefCon (sel_menu, menu_item_selection, &refcon);
1986 else if (! for_click)
1987 /* Make "Cancel" equivalent to C-g unless this menu was popped up by
1988 a mouse press. */
1989 Fsignal (Qquit, Qnil);
1991 /* Find the selected item, and its pane, to return
1992 the proper value. */
1993 if (menu_item_selection != 0)
1995 Lisp_Object prefix, entry;
1997 prefix = entry = Qnil;
1998 i = 0;
1999 while (i < menu_items_used)
2001 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2003 subprefix_stack[submenu_depth++] = prefix;
2004 prefix = entry;
2005 i++;
2007 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2009 prefix = subprefix_stack[--submenu_depth];
2010 i++;
2012 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2014 prefix
2015 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2016 i += MENU_ITEMS_PANE_LENGTH;
2018 /* Ignore a nil in the item list.
2019 It's meaningful only for dialog boxes. */
2020 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2021 i += 1;
2022 else
2024 entry
2025 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2026 if ((int) (EMACS_INT) refcon == i)
2028 if (keymaps != 0)
2030 int j;
2032 entry = Fcons (entry, Qnil);
2033 if (!NILP (prefix))
2034 entry = Fcons (prefix, entry);
2035 for (j = submenu_depth - 1; j >= 0; j--)
2036 if (!NILP (subprefix_stack[j]))
2037 entry = Fcons (subprefix_stack[j], entry);
2039 return entry;
2041 i += MENU_ITEMS_ITEM_LENGTH;
2045 else if (!for_click)
2046 /* Make "Cancel" equivalent to C-g. */
2047 Fsignal (Qquit, Qnil);
2049 unbind_to (specpdl_count, Qnil);
2051 return Qnil;
2055 #ifdef HAVE_DIALOGS
2056 /* Construct native Mac OS menubar based on widget_value tree. */
2058 static int
2059 mac_dialog (widget_value *wv)
2061 char *dialog_name;
2062 char *prompt;
2063 char **button_labels;
2064 UInt32 *ref_cons;
2065 int nb_buttons;
2066 int left_count;
2067 int i;
2068 int dialog_width;
2069 Rect rect;
2070 WindowPtr window_ptr;
2071 ControlHandle ch;
2072 int left;
2073 EventRecord event_record;
2074 SInt16 part_code;
2075 int control_part_code;
2076 Point mouse;
2078 dialog_name = wv->name;
2079 nb_buttons = dialog_name[1] - '0';
2080 left_count = nb_buttons - (dialog_name[4] - '0');
2081 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
2082 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
2084 wv = wv->contents;
2085 prompt = (char *) alloca (strlen (wv->value) + 1);
2086 strcpy (prompt, wv->value);
2087 c2pstr (prompt);
2089 wv = wv->next;
2090 for (i = 0; i < nb_buttons; i++)
2092 button_labels[i] = wv->value;
2093 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
2094 strcpy (button_labels[i], wv->value);
2095 c2pstr (button_labels[i]);
2096 ref_cons[i] = (UInt32) wv->call_data;
2097 wv = wv->next;
2100 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
2102 SetPortWindowPort (window_ptr);
2104 TextFont (0);
2105 /* Left and right margins in the dialog are 13 pixels each.*/
2106 dialog_width = 14;
2107 /* Calculate width of dialog box: 8 pixels on each side of the text
2108 label in each button, 12 pixels between buttons. */
2109 for (i = 0; i < nb_buttons; i++)
2110 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
2112 if (left_count != 0 && nb_buttons - left_count != 0)
2113 dialog_width += 12;
2115 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
2117 SizeWindow (window_ptr, dialog_width, 78, 0);
2118 ShowWindow (window_ptr);
2120 SetPortWindowPort (window_ptr);
2122 TextFont (0);
2124 MoveTo (13, 29);
2125 DrawString (prompt);
2127 left = 13;
2128 for (i = 0; i < nb_buttons; i++)
2130 int button_width = StringWidth (button_labels[i]) + 16;
2131 SetRect (&rect, left, 45, left + button_width, 65);
2132 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2133 kControlPushButtonProc, ref_cons[i]);
2134 left += button_width + 12;
2135 if (i == left_count - 1)
2136 left += 12;
2139 i = 0;
2140 while (!i)
2142 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2143 if (event_record.what == mouseDown)
2145 part_code = FindWindow (event_record.where, &window_ptr);
2146 if (part_code == inContent)
2148 mouse = event_record.where;
2149 GlobalToLocal (&mouse);
2150 control_part_code = FindControl (mouse, window_ptr, &ch);
2151 if (control_part_code == kControlButtonPart)
2152 if (TrackControl (ch, mouse, NULL))
2153 i = GetControlReference (ch);
2158 DisposeWindow (window_ptr);
2160 return i;
2163 static char * button_names [] = {
2164 "button1", "button2", "button3", "button4", "button5",
2165 "button6", "button7", "button8", "button9", "button10" };
2167 static Lisp_Object
2168 mac_dialog_show (f, keymaps, title, header, error)
2169 FRAME_PTR f;
2170 int keymaps;
2171 Lisp_Object title, header;
2172 char **error;
2174 int i, nb_buttons=0;
2175 char dialog_name[6];
2176 int menu_item_selection;
2178 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2180 /* Number of elements seen so far, before boundary. */
2181 int left_count = 0;
2182 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2183 int boundary_seen = 0;
2185 *error = NULL;
2187 if (menu_items_n_panes > 1)
2189 *error = "Multiple panes in dialog box";
2190 return Qnil;
2193 /* Create a tree of widget_value objects
2194 representing the text label and buttons. */
2196 Lisp_Object pane_name, prefix;
2197 char *pane_string;
2198 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2199 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2200 pane_string = (NILP (pane_name)
2201 ? "" : (char *) SDATA (pane_name));
2202 prev_wv = xmalloc_widget_value ();
2203 prev_wv->value = pane_string;
2204 if (keymaps && !NILP (prefix))
2205 prev_wv->name++;
2206 prev_wv->enabled = 1;
2207 prev_wv->name = "message";
2208 prev_wv->help = Qnil;
2209 first_wv = prev_wv;
2211 /* Loop over all panes and items, filling in the tree. */
2212 i = MENU_ITEMS_PANE_LENGTH;
2213 while (i < menu_items_used)
2216 /* Create a new item within current pane. */
2217 Lisp_Object item_name, enable, descrip, help;
2219 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2220 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2221 descrip
2222 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2223 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
2225 if (NILP (item_name))
2227 free_menubar_widget_value_tree (first_wv);
2228 *error = "Submenu in dialog items";
2229 return Qnil;
2231 if (EQ (item_name, Qquote))
2233 /* This is the boundary between left-side elts
2234 and right-side elts. Stop incrementing right_count. */
2235 boundary_seen = 1;
2236 i++;
2237 continue;
2239 if (nb_buttons >= 9)
2241 free_menubar_widget_value_tree (first_wv);
2242 *error = "Too many dialog items";
2243 return Qnil;
2246 wv = xmalloc_widget_value ();
2247 prev_wv->next = wv;
2248 wv->name = (char *) button_names[nb_buttons];
2249 if (!NILP (descrip))
2250 wv->key = (char *) SDATA (descrip);
2251 wv->value = (char *) SDATA (item_name);
2252 wv->call_data = (void *) i;
2253 /* menu item is identified by its index in menu_items table */
2254 wv->enabled = !NILP (enable);
2255 wv->help = Qnil;
2256 prev_wv = wv;
2258 if (! boundary_seen)
2259 left_count++;
2261 nb_buttons++;
2262 i += MENU_ITEMS_ITEM_LENGTH;
2265 /* If the boundary was not specified,
2266 by default put half on the left and half on the right. */
2267 if (! boundary_seen)
2268 left_count = nb_buttons - nb_buttons / 2;
2270 wv = xmalloc_widget_value ();
2271 wv->name = dialog_name;
2272 wv->help = Qnil;
2274 /* Frame title: 'Q' = Question, 'I' = Information.
2275 Can also have 'E' = Error if, one day, we want
2276 a popup for errors. */
2277 if (NILP(header))
2278 dialog_name[0] = 'Q';
2279 else
2280 dialog_name[0] = 'I';
2282 /* Dialog boxes use a really stupid name encoding
2283 which specifies how many buttons to use
2284 and how many buttons are on the right. */
2285 dialog_name[1] = '0' + nb_buttons;
2286 dialog_name[2] = 'B';
2287 dialog_name[3] = 'R';
2288 /* Number of buttons to put on the right. */
2289 dialog_name[4] = '0' + nb_buttons - left_count;
2290 dialog_name[5] = 0;
2291 wv->contents = first_wv;
2292 first_wv = wv;
2295 /* Actually create the dialog. */
2296 #ifdef HAVE_DIALOGS
2297 menu_item_selection = mac_dialog (first_wv);
2298 #else
2299 menu_item_selection = 0;
2300 #endif
2302 /* Free the widget_value objects we used to specify the contents. */
2303 free_menubar_widget_value_tree (first_wv);
2305 /* Find the selected item, and its pane, to return the proper
2306 value. */
2307 if (menu_item_selection != 0)
2309 Lisp_Object prefix;
2311 prefix = Qnil;
2312 i = 0;
2313 while (i < menu_items_used)
2315 Lisp_Object entry;
2317 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2319 prefix
2320 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2321 i += MENU_ITEMS_PANE_LENGTH;
2323 else
2325 entry
2326 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2327 if (menu_item_selection == i)
2329 if (keymaps != 0)
2331 entry = Fcons (entry, Qnil);
2332 if (!NILP (prefix))
2333 entry = Fcons (prefix, entry);
2335 return entry;
2337 i += MENU_ITEMS_ITEM_LENGTH;
2342 return Qnil;
2344 #endif /* HAVE_DIALOGS */
2347 /* Is this item a separator? */
2348 static int
2349 name_is_separator (name)
2350 char *name;
2352 char *start = name;
2354 /* Check if name string consists of only dashes ('-'). */
2355 while (*name == '-') name++;
2356 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2357 or "--deep-shadow". We don't implement them yet, se we just treat
2358 them like normal separators. */
2359 return (*name == '\0' || start + 2 == name);
2362 static void
2363 add_menu_item (MenuHandle menu, widget_value *wv, int submenu,
2364 int force_disable)
2366 Str255 item_name;
2367 int pos;
2369 if (name_is_separator (wv->name))
2370 AppendMenu (menu, "\p-");
2371 else
2373 AppendMenu (menu, "\pX");
2375 #if TARGET_API_MAC_CARBON
2376 pos = CountMenuItems (menu);
2377 #else
2378 pos = CountMItems (menu);
2379 #endif
2381 strcpy (item_name, "");
2382 strncat (item_name, wv->name, 255);
2383 if (wv->key != NULL)
2385 strncat (item_name, " ", 255);
2386 strncat (item_name, wv->key, 255);
2388 item_name[255] = 0;
2389 #if TARGET_API_MAC_CARBON
2391 CFStringRef string = cfstring_create_with_utf8_cstring (item_name);
2393 SetMenuItemTextWithCFString (menu, pos, string);
2394 CFRelease (string);
2396 #else
2397 c2pstr (item_name);
2398 SetMenuItemText (menu, pos, item_name);
2399 #endif
2401 if (wv->enabled && !force_disable)
2402 #if TARGET_API_MAC_CARBON
2403 EnableMenuItem (menu, pos);
2404 #else
2405 EnableItem (menu, pos);
2406 #endif
2407 else
2408 #if TARGET_API_MAC_CARBON
2409 DisableMenuItem (menu, pos);
2410 #else
2411 DisableItem (menu, pos);
2412 #endif
2414 /* Draw radio buttons and tickboxes. */
2416 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2417 wv->button_type == BUTTON_TYPE_RADIO))
2418 SetItemMark (menu, pos, checkMark);
2419 else
2420 SetItemMark (menu, pos, noMark);
2423 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
2426 if (submenu != NULL)
2427 SetMenuItemHierarchicalID (menu, pos, submenu);
2430 /* Construct native Mac OS menubar based on widget_value tree. */
2432 static void
2433 fill_submenu (MenuHandle menu, widget_value *wv)
2435 for ( ; wv != NULL; wv = wv->next)
2436 if (wv->contents)
2438 int cur_submenu = submenu_id++;
2439 MenuHandle submenu = NewMenu (cur_submenu, "\pX");
2440 fill_submenu (submenu, wv->contents);
2441 InsertMenu (submenu, -1);
2442 add_menu_item (menu, wv, cur_submenu, 0);
2444 else
2445 add_menu_item (menu, wv, NULL, 0);
2449 /* Construct native Mac OS menu based on widget_value tree. */
2451 static void
2452 fill_menu (MenuHandle menu, widget_value *wv)
2454 for ( ; wv != NULL; wv = wv->next)
2455 if (wv->contents)
2457 int cur_submenu = submenu_id++;
2458 MenuHandle submenu = NewMenu (cur_submenu, "\pX");
2459 fill_submenu (submenu, wv->contents);
2460 InsertMenu (submenu, -1);
2461 add_menu_item (menu, wv, cur_submenu, 0);
2463 else
2464 add_menu_item (menu, wv, NULL, 0);
2467 /* Construct native Mac OS menubar based on widget_value tree. */
2469 static void
2470 fill_menubar (widget_value *wv)
2472 int id;
2474 submenu_id = MIN_SUBMENU_ID;
2476 for (id = MIN_MENU_ID; wv != NULL; wv = wv->next, id++)
2478 MenuHandle menu;
2479 Str255 title;
2481 strncpy (title, wv->name, 255);
2482 title[255] = 0;
2483 c2pstr (title);
2484 menu = NewMenu (id, title);
2486 if (wv->contents)
2487 fill_menu (menu, wv->contents);
2489 InsertMenu (menu, 0);
2493 #endif /* HAVE_MENUS */
2496 void
2497 syms_of_macmenu ()
2499 staticpro (&menu_items);
2500 menu_items = Qnil;
2502 Qdebug_on_next_call = intern ("debug-on-next-call");
2503 staticpro (&Qdebug_on_next_call);
2505 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2506 doc: /* Frame for which we are updating a menu.
2507 The enable predicate for a menu command should check this variable. */);
2508 Vmenu_updating_frame = Qnil;
2510 defsubr (&Sx_popup_menu);
2511 #ifdef HAVE_MENUS
2512 defsubr (&Sx_popup_dialog);
2513 #endif
2516 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2517 (do not change this comment) */