(reb-mode): Quote the hook name. From
[emacs.git] / mac / src / macmenu.c
blobac697cf7490c635759922a06e7bffedef6acd6f2
1 /* Menu support for GNU Emacs on the for Mac OS.
2 Copyright (C) 2000 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., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Contributed by Andrew Choi (akochoi@users.sourceforge.net). */
23 #include <config.h>
24 #include <signal.h>
26 #include <stdio.h>
27 #include "lisp.h"
28 #include "termhooks.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "keyboard.h"
32 #include "blockinput.h"
33 #include "buffer.h"
34 #include "charset.h"
35 #include "coding.h"
37 #include <MacTypes.h>
38 #include <Menus.h>
39 #include <QuickDraw.h>
40 #include <ToolUtils.h>
41 #include <Fonts.h>
42 #include <Controls.h>
43 #include <Windows.h>
44 #include <Events.h>
45 #if defined (__MRC__) || defined (CODEWARRIOR_VERSION_6)
46 #include <ControlDefinitions.h>
47 #endif
49 /* This may include sys/types.h, and that somehow loses
50 if this is not done before the other system files. */
51 #include "macterm.h"
53 /* Load sys/types.h if not already loaded.
54 In some systems loading it twice is suicidal. */
55 #ifndef makedev
56 #include <sys/types.h>
57 #endif
59 #include "dispextern.h"
61 #define POPUP_SUBMENU_ID 235
62 #define MIN_MENU_ID 256
63 #define MIN_SUBMENU_ID 1
65 #define DIALOG_WINDOW_RESOURCE 130
67 #define HAVE_DIALOGS 1
69 #undef HAVE_MULTILINGUAL_MENU
71 /******************************************************************/
72 /* Definitions copied from lwlib.h */
74 typedef void * XtPointer;
76 #define True 1
77 #define False 0
79 enum button_type
81 BUTTON_TYPE_NONE,
82 BUTTON_TYPE_TOGGLE,
83 BUTTON_TYPE_RADIO
86 typedef struct _widget_value
88 /* name of widget */
89 char* name;
90 /* value (meaning depend on widget type) */
91 char* value;
92 /* keyboard equivalent. no implications for XtTranslations */
93 char* key;
94 /* Help string or null if none. */
95 char *help;
96 /* true if enabled */
97 Boolean enabled;
98 /* true if selected */
99 Boolean selected;
100 /* The type of a button. */
101 enum button_type button_type;
102 /* true if menu title */
103 Boolean title;
104 #if 0
105 /* true if was edited (maintained by get_value) */
106 Boolean edited;
107 /* true if has changed (maintained by lw library) */
108 change_type change;
109 /* true if this widget itself has changed,
110 but not counting the other widgets found in the `next' field. */
111 change_type this_one_change;
112 #endif
113 /* Contents of the sub-widgets, also selected slot for checkbox */
114 struct _widget_value* contents;
115 /* data passed to callback */
116 XtPointer call_data;
117 /* next one in the list */
118 struct _widget_value* next;
119 #if 0
120 /* slot for the toolkit dependent part. Always initialize to NULL. */
121 void* toolkit_data;
122 /* tell us if we should free the toolkit data slot when freeing the
123 widget_value itself. */
124 Boolean free_toolkit_data;
126 /* we resource the widget_value structures; this points to the next
127 one on the free list if this one has been deallocated.
129 struct _widget_value *free_list;
130 #endif
131 } widget_value;
133 /* Assumed by other routines to zero area returned. */
134 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
135 0, (sizeof (widget_value)))
136 #define free_widget_value(wv) xfree (wv)
138 /******************************************************************/
140 #define min(x,y) (((x) < (y)) ? (x) : (y))
141 #define max(x,y) (((x) > (y)) ? (x) : (y))
143 #ifndef TRUE
144 #define TRUE 1
145 #define FALSE 0
146 #endif /* no TRUE */
148 Lisp_Object Vmenu_updating_frame;
150 Lisp_Object Qdebug_on_next_call;
152 extern Lisp_Object Qmenu_bar;
153 extern Lisp_Object Qmouse_click, Qevent_kind;
155 extern Lisp_Object QCtoggle, QCradio;
157 extern Lisp_Object Voverriding_local_map;
158 extern Lisp_Object Voverriding_local_map_menu_flag;
160 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
162 extern Lisp_Object Qmenu_bar_update_hook;
164 void set_frame_menubar ();
166 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
167 Lisp_Object, Lisp_Object, Lisp_Object,
168 Lisp_Object, Lisp_Object));
169 static Lisp_Object mac_dialog_show ();
170 static Lisp_Object mac_menu_show ();
172 static void keymap_panes ();
173 static void single_keymap_panes ();
174 static void single_menu_item ();
175 static void list_of_panes ();
176 static void list_of_items ();
178 static void fill_submenu (MenuHandle, widget_value *, int);
179 static void fill_menubar (widget_value *);
182 /* This holds a Lisp vector that holds the results of decoding
183 the keymaps or alist-of-alists that specify a menu.
185 It describes the panes and items within the panes.
187 Each pane is described by 3 elements in the vector:
188 t, the pane name, the pane's prefix key.
189 Then follow the pane's items, with 5 elements per item:
190 the item string, the enable flag, the item's value,
191 the definition, and the equivalent keyboard key's description string.
193 In some cases, multiple levels of menus may be described.
194 A single vector slot containing nil indicates the start of a submenu.
195 A single vector slot containing lambda indicates the end of a submenu.
196 The submenu follows a menu item which is the way to reach the submenu.
198 A single vector slot containing quote indicates that the
199 following items should appear on the right of a dialog box.
201 Using a Lisp vector to hold this information while we decode it
202 takes care of protecting all the data from GC. */
204 #define MENU_ITEMS_PANE_NAME 1
205 #define MENU_ITEMS_PANE_PREFIX 2
206 #define MENU_ITEMS_PANE_LENGTH 3
208 enum menu_item_idx
210 MENU_ITEMS_ITEM_NAME = 0,
211 MENU_ITEMS_ITEM_ENABLE,
212 MENU_ITEMS_ITEM_VALUE,
213 MENU_ITEMS_ITEM_EQUIV_KEY,
214 MENU_ITEMS_ITEM_DEFINITION,
215 MENU_ITEMS_ITEM_TYPE,
216 MENU_ITEMS_ITEM_SELECTED,
217 MENU_ITEMS_ITEM_HELP,
218 MENU_ITEMS_ITEM_LENGTH
221 static Lisp_Object menu_items;
223 /* Number of slots currently allocated in menu_items. */
224 static int menu_items_allocated;
226 /* This is the index in menu_items of the first empty slot. */
227 static int menu_items_used;
229 /* The number of panes currently recorded in menu_items,
230 excluding those within submenus. */
231 static int menu_items_n_panes;
233 /* Current depth within submenus. */
234 static int menu_items_submenu_depth;
236 /* Flag which when set indicates a dialog or menu has been posted by
237 Xt on behalf of one of the widget sets. */
238 static int popup_activated_flag;
240 static int next_menubar_widget_id;
242 /* This is set nonzero after the user activates the menu bar, and set
243 to zero again after the menu bars are redisplayed by prepare_menu_bar.
244 While it is nonzero, all calls to set_frame_menubar go deep.
246 I don't understand why this is needed, but it does seem to be
247 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
249 int pending_menu_activation;
251 /* Initialize the menu_items structure if we haven't already done so.
252 Also mark it as currently empty. */
254 static void
255 init_menu_items ()
257 if (NILP (menu_items))
259 menu_items_allocated = 60;
260 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
263 menu_items_used = 0;
264 menu_items_n_panes = 0;
265 menu_items_submenu_depth = 0;
268 /* Call at the end of generating the data in menu_items.
269 This fills in the number of items in the last pane. */
271 static void
272 finish_menu_items ()
276 /* Call when finished using the data for the current menu
277 in menu_items. */
279 static void
280 discard_menu_items ()
282 /* Free the structure if it is especially large.
283 Otherwise, hold on to it, to save time. */
284 if (menu_items_allocated > 200)
286 menu_items = Qnil;
287 menu_items_allocated = 0;
291 /* Make the menu_items vector twice as large. */
293 static void
294 grow_menu_items ()
296 Lisp_Object old;
297 int old_size = menu_items_allocated;
298 old = menu_items;
300 menu_items_allocated *= 2;
301 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
302 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
303 old_size * sizeof (Lisp_Object));
306 /* Begin a submenu. */
308 static void
309 push_submenu_start ()
311 if (menu_items_used + 1 > menu_items_allocated)
312 grow_menu_items ();
314 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
315 menu_items_submenu_depth++;
318 /* End a submenu. */
320 static void
321 push_submenu_end ()
323 if (menu_items_used + 1 > menu_items_allocated)
324 grow_menu_items ();
326 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
327 menu_items_submenu_depth--;
330 /* Indicate boundary between left and right. */
332 static void
333 push_left_right_boundary ()
335 if (menu_items_used + 1 > menu_items_allocated)
336 grow_menu_items ();
338 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
341 /* Start a new menu pane in menu_items..
342 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
344 static void
345 push_menu_pane (name, prefix_vec)
346 Lisp_Object name, prefix_vec;
348 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
349 grow_menu_items ();
351 if (menu_items_submenu_depth == 0)
352 menu_items_n_panes++;
353 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
354 XVECTOR (menu_items)->contents[menu_items_used++] = name;
355 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
358 /* Push one menu item into the current pane. NAME is the string to
359 display. ENABLE if non-nil means this item can be selected. KEY
360 is the key generated by choosing this item, or nil if this item
361 doesn't really have a definition. DEF is the definition of this
362 item. EQUIV is the textual description of the keyboard equivalent
363 for this item (or nil if none). TYPE is the type of this menu
364 item, one of nil, `toggle' or `radio'. */
366 static void
367 push_menu_item (name, enable, key, def, equiv, type, selected, help)
368 Lisp_Object name, enable, key, def, equiv, type, selected, help;
370 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
371 grow_menu_items ();
373 XVECTOR (menu_items)->contents[menu_items_used++] = name;
374 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
375 XVECTOR (menu_items)->contents[menu_items_used++] = key;
376 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
377 XVECTOR (menu_items)->contents[menu_items_used++] = def;
378 XVECTOR (menu_items)->contents[menu_items_used++] = type;
379 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
380 XVECTOR (menu_items)->contents[menu_items_used++] = help;
383 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
384 and generate menu panes for them in menu_items.
385 If NOTREAL is nonzero,
386 don't bother really computing whether an item is enabled. */
388 static void
389 keymap_panes (keymaps, nmaps, notreal)
390 Lisp_Object *keymaps;
391 int nmaps;
392 int notreal;
394 int mapno;
396 init_menu_items ();
398 /* Loop over the given keymaps, making a pane for each map.
399 But don't make a pane that is empty--ignore that map instead.
400 P is the number of panes we have made so far. */
401 for (mapno = 0; mapno < nmaps; mapno++)
402 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal, 10);
404 finish_menu_items ();
407 /* This is a recursive subroutine of keymap_panes.
408 It handles one keymap, KEYMAP.
409 The other arguments are passed along
410 or point to local variables of the previous function.
411 If NOTREAL is nonzero, only check for equivalent key bindings, don't
412 evaluate expressions in menu items and don't make any menu.
414 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
416 static void
417 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
418 Lisp_Object keymap;
419 Lisp_Object pane_name;
420 Lisp_Object prefix;
421 int notreal;
422 int maxdepth;
424 Lisp_Object pending_maps = Qnil;
425 Lisp_Object tail, item;
426 struct gcpro gcpro1, gcpro2;
428 if (maxdepth <= 0)
429 return;
431 push_menu_pane (pane_name, prefix);
433 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
435 GCPRO2 (keymap, pending_maps);
436 /* Look at each key binding, and if it is a menu item add it
437 to this menu. */
438 item = XCAR (tail);
439 if (CONSP (item))
440 single_menu_item (XCAR (item), XCDR (item),
441 &pending_maps, notreal, maxdepth);
442 else if (VECTORP (item))
444 /* Loop over the char values represented in the vector. */
445 int len = XVECTOR (item)->size;
446 int c;
447 for (c = 0; c < len; c++)
449 Lisp_Object character;
450 XSETFASTINT (character, c);
451 single_menu_item (character, XVECTOR (item)->contents[c],
452 &pending_maps, notreal, maxdepth);
455 UNGCPRO;
458 /* Process now any submenus which want to be panes at this level. */
459 while (!NILP (pending_maps))
461 Lisp_Object elt, eltcdr, string;
462 elt = Fcar (pending_maps);
463 eltcdr = XCDR (elt);
464 string = XCAR (eltcdr);
465 /* We no longer discard the @ from the beginning of the string here.
466 Instead, we do this in mac_menu_show. */
467 single_keymap_panes (Fcar (elt), string,
468 XCDR (eltcdr), notreal, maxdepth - 1);
469 pending_maps = Fcdr (pending_maps);
473 /* This is a subroutine of single_keymap_panes that handles one
474 keymap entry.
475 KEY is a key in a keymap and ITEM is its binding.
476 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
477 separate panes.
478 If NOTREAL is nonzero, only check for equivalent key bindings, don't
479 evaluate expressions in menu items and don't make any menu.
480 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
482 static void
483 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
484 Lisp_Object key, item;
485 Lisp_Object *pending_maps_ptr;
486 int maxdepth, notreal;
488 Lisp_Object map, item_string, enabled;
489 struct gcpro gcpro1, gcpro2;
490 int res;
492 /* Parse the menu item and leave the result in item_properties. */
493 GCPRO2 (key, item);
494 res = parse_menu_item (item, notreal, 0);
495 UNGCPRO;
496 if (!res)
497 return; /* Not a menu item. */
499 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
501 if (notreal)
503 /* We don't want to make a menu, just traverse the keymaps to
504 precompute equivalent key bindings. */
505 if (!NILP (map))
506 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
507 return;
510 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
511 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
513 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
515 if (!NILP (enabled))
516 /* An enabled separate pane. Remember this to handle it later. */
517 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
518 *pending_maps_ptr);
519 return;
522 push_menu_item (item_string, enabled, key,
523 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
524 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
525 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
526 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
527 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
529 /* Display a submenu using the toolkit. */
530 if (! (NILP (map) || NILP (enabled)))
532 push_submenu_start ();
533 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
534 push_submenu_end ();
538 /* Push all the panes and items of a menu described by the
539 alist-of-alists MENU.
540 This handles old-fashioned calls to x-popup-menu. */
542 static void
543 list_of_panes (menu)
544 Lisp_Object menu;
546 Lisp_Object tail;
548 init_menu_items ();
550 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
552 Lisp_Object elt, pane_name, pane_data;
553 elt = Fcar (tail);
554 pane_name = Fcar (elt);
555 CHECK_STRING (pane_name, 0);
556 push_menu_pane (pane_name, Qnil);
557 pane_data = Fcdr (elt);
558 CHECK_CONS (pane_data, 0);
559 list_of_items (pane_data);
562 finish_menu_items ();
565 /* Push the items in a single pane defined by the alist PANE. */
567 static void
568 list_of_items (pane)
569 Lisp_Object pane;
571 Lisp_Object tail, item, item1;
573 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
575 item = Fcar (tail);
576 if (STRINGP (item))
577 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
578 else if (NILP (item))
579 push_left_right_boundary ();
580 else
582 CHECK_CONS (item, 0);
583 item1 = Fcar (item);
584 CHECK_STRING (item1, 1);
585 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
590 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
591 "Pop up a deck-of-cards menu and return user's selection.\n\
592 POSITION is a position specification. This is either a mouse button event\n\
593 or a list ((XOFFSET YOFFSET) WINDOW)\n\
594 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
595 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
596 This controls the position of the center of the first line\n\
597 in the first pane of the menu, not the top left of the menu as a whole.\n\
598 If POSITION is t, it means to use the current mouse position.\n\
600 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
601 The menu items come from key bindings that have a menu string as well as\n\
602 a definition; actually, the \"definition\" in such a key binding looks like\n\
603 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
604 the keymap as a top-level element.\n\n\
605 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
606 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
608 You can also use a list of keymaps as MENU.\n\
609 Then each keymap makes a separate pane.\n\
610 When MENU is a keymap or a list of keymaps, the return value\n\
611 is a list of events.\n\n\
613 Alternatively, you can specify a menu of multiple panes\n\
614 with a list of the form (TITLE PANE1 PANE2...),\n\
615 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
616 Each ITEM is normally a cons cell (STRING . VALUE);\n\
617 but a string can appear as an item--that makes a nonselectable line\n\
618 in the menu.\n\
619 With this form of menu, the return value is VALUE from the chosen item.\n\
621 If POSITION is nil, don't display the menu at all, just precalculate the\n\
622 cached information about equivalent key sequences.")
623 (position, menu)
624 Lisp_Object position, menu;
626 Lisp_Object keymap, tem;
627 int xpos, ypos;
628 Lisp_Object title;
629 char *error_name;
630 Lisp_Object selection;
631 FRAME_PTR f;
632 Lisp_Object x, y, window;
633 int keymaps = 0;
634 int for_click = 0;
635 struct gcpro gcpro1;
637 #ifdef HAVE_MENUS
638 if (! NILP (position))
640 check_mac ();
642 /* Decode the first argument: find the window and the coordinates. */
643 if (EQ (position, Qt)
644 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
646 /* Use the mouse's current position. */
647 FRAME_PTR new_f = SELECTED_FRAME ();
648 Lisp_Object bar_window;
649 enum scroll_bar_part part;
650 unsigned long time;
652 if (mouse_position_hook)
653 (*mouse_position_hook) (&new_f, 1, &bar_window,
654 &part, &x, &y, &time);
655 if (new_f != 0)
656 XSETFRAME (window, new_f);
657 else
659 window = selected_window;
660 XSETFASTINT (x, 0);
661 XSETFASTINT (y, 0);
664 else
666 tem = Fcar (position);
667 if (CONSP (tem))
669 window = Fcar (Fcdr (position));
670 x = Fcar (tem);
671 y = Fcar (Fcdr (tem));
673 else
675 for_click = 1;
676 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
677 window = Fcar (tem); /* POSN_WINDOW (tem) */
678 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
679 x = Fcar (tem);
680 y = Fcdr (tem);
684 CHECK_NUMBER (x, 0);
685 CHECK_NUMBER (y, 0);
687 /* Decode where to put the menu. */
689 if (FRAMEP (window))
691 f = XFRAME (window);
692 xpos = 0;
693 ypos = 0;
695 else if (WINDOWP (window))
697 CHECK_LIVE_WINDOW (window, 0);
698 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
700 xpos = (FONT_WIDTH (FRAME_FONT (f))
701 * XFASTINT (XWINDOW (window)->left));
702 ypos = (FRAME_LINE_HEIGHT (f)
703 * XFASTINT (XWINDOW (window)->top));
705 else
706 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
707 but I don't want to make one now. */
708 CHECK_WINDOW (window, 0);
710 xpos += XINT (x);
711 ypos += XINT (y);
713 XSETFRAME (Vmenu_updating_frame, f);
715 Vmenu_updating_frame = Qnil;
716 #endif /* HAVE_MENUS */
718 title = Qnil;
719 GCPRO1 (title);
721 /* Decode the menu items from what was specified. */
723 keymap = Fkeymapp (menu);
724 tem = Qnil;
725 if (CONSP (menu))
726 tem = Fkeymapp (Fcar (menu));
727 if (!NILP (keymap))
729 /* We were given a keymap. Extract menu info from the keymap. */
730 Lisp_Object prompt;
731 keymap = get_keymap (menu);
733 /* Extract the detailed info to make one pane. */
734 keymap_panes (&menu, 1, NILP (position));
736 /* Search for a string appearing directly as an element of the keymap.
737 That string is the title of the menu. */
738 prompt = map_prompt (keymap);
739 if (NILP (title) && !NILP (prompt))
740 title = prompt;
742 /* Make that be the pane title of the first pane. */
743 if (!NILP (prompt) && menu_items_n_panes >= 0)
744 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
746 keymaps = 1;
748 else if (!NILP (tem))
750 /* We were given a list of keymaps. */
751 int nmaps = XFASTINT (Flength (menu));
752 Lisp_Object *maps
753 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
754 int i;
756 title = Qnil;
758 /* The first keymap that has a prompt string
759 supplies the menu title. */
760 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
762 Lisp_Object prompt;
764 maps[i++] = keymap = get_keymap (Fcar (tem));
766 prompt = map_prompt (keymap);
767 if (NILP (title) && !NILP (prompt))
768 title = prompt;
771 /* Extract the detailed info to make one pane. */
772 keymap_panes (maps, nmaps, NILP (position));
774 /* Make the title be the pane title of the first pane. */
775 if (!NILP (title) && menu_items_n_panes >= 0)
776 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
778 keymaps = 1;
780 else
782 /* We were given an old-fashioned menu. */
783 title = Fcar (menu);
784 CHECK_STRING (title, 1);
786 list_of_panes (Fcdr (menu));
788 keymaps = 0;
791 if (NILP (position))
793 discard_menu_items ();
794 UNGCPRO;
795 return Qnil;
798 #ifdef HAVE_MENUS
799 /* Display them in a menu. */
800 BLOCK_INPUT;
802 selection = mac_menu_show (f, xpos, ypos, for_click,
803 keymaps, title, &error_name);
804 UNBLOCK_INPUT;
806 discard_menu_items ();
808 UNGCPRO;
809 #endif /* HAVE_MENUS */
811 if (error_name) error (error_name);
812 return selection;
815 #ifdef HAVE_MENUS
817 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
818 "Pop up a dialog box and return user's selection.\n\
819 POSITION specifies which frame to use.\n\
820 This is normally a mouse button event or a window or frame.\n\
821 If POSITION is t, it means to use the frame the mouse is on.\n\
822 The dialog box appears in the middle of the specified frame.\n\
824 CONTENTS specifies the alternatives to display in the dialog box.\n\
825 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
826 Each ITEM is a cons cell (STRING . VALUE).\n\
827 The return value is VALUE from the chosen item.\n\n\
828 An ITEM may also be just a string--that makes a nonselectable item.\n\
829 An ITEM may also be nil--that means to put all preceding items\n\
830 on the left of the dialog box and all following items on the right.\n\
831 \(By default, approximately half appear on each side.)")
832 (position, contents)
833 Lisp_Object position, contents;
835 FRAME_PTR f;
836 Lisp_Object window;
838 check_mac ();
840 /* Decode the first argument: find the window or frame to use. */
841 if (EQ (position, Qt)
842 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
844 #if 0 /* Using the frame the mouse is on may not be right. */
845 /* Use the mouse's current position. */
846 FRAME_PTR new_f = SELECTED_FRAME ();
847 Lisp_Object bar_window;
848 int part;
849 unsigned long time;
850 Lisp_Object x, y;
852 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
854 if (new_f != 0)
855 XSETFRAME (window, new_f);
856 else
857 window = selected_window;
858 #endif
859 window = selected_window;
861 else if (CONSP (position))
863 Lisp_Object tem;
864 tem = Fcar (position);
865 if (CONSP (tem))
866 window = Fcar (Fcdr (position));
867 else
869 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
870 window = Fcar (tem); /* POSN_WINDOW (tem) */
873 else if (WINDOWP (position) || FRAMEP (position))
874 window = position;
875 else
876 window = Qnil;
878 /* Decode where to put the menu. */
880 if (FRAMEP (window))
881 f = XFRAME (window);
882 else if (WINDOWP (window))
884 CHECK_LIVE_WINDOW (window, 0);
885 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
887 else
888 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
889 but I don't want to make one now. */
890 CHECK_WINDOW (window, 0);
892 #ifndef HAVE_DIALOGS
893 /* Display a menu with these alternatives
894 in the middle of frame F. */
896 Lisp_Object x, y, frame, newpos;
897 XSETFRAME (frame, f);
898 XSETINT (x, x_pixel_width (f) / 2);
899 XSETINT (y, x_pixel_height (f) / 2);
900 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
902 return Fx_popup_menu (newpos,
903 Fcons (Fcar (contents), Fcons (contents, Qnil)));
905 #else /* HAVE_DIALOGS */
907 Lisp_Object title;
908 char *error_name;
909 Lisp_Object selection;
911 /* Decode the dialog items from what was specified. */
912 title = Fcar (contents);
913 CHECK_STRING (title, 1);
915 list_of_panes (Fcons (contents, Qnil));
917 /* Display them in a dialog box. */
918 BLOCK_INPUT;
919 selection = mac_dialog_show (f, 0, title, &error_name);
920 UNBLOCK_INPUT;
922 discard_menu_items ();
924 if (error_name) error (error_name);
925 return selection;
927 #endif /* HAVE_DIALOGS */
930 /* Activate the menu bar of frame F.
931 This is called from keyboard.c when it gets the
932 menu_bar_activate_event out of the Emacs event queue.
934 To activate the menu bar, we signal to the input thread that it can
935 return from the WM_INITMENU message, allowing the normal Windows
936 processing of the menus.
938 But first we recompute the menu bar contents (the whole tree).
940 This way we can safely execute Lisp code. */
942 void
943 x_activate_menubar (f)
944 FRAME_PTR f;
946 SInt32 menu_choice;
947 extern Point saved_menu_event_location;
949 set_frame_menubar (f, 0, 1);
950 BLOCK_INPUT;
952 menu_choice = MenuSelect (saved_menu_event_location);
953 do_menu_choice (menu_choice);
955 UNBLOCK_INPUT;
958 /* This callback is called from the menu bar pulldown menu
959 when the user makes a selection.
960 Figure out what the user chose
961 and put the appropriate events into the keyboard buffer. */
963 void
964 menubar_selection_callback (FRAME_PTR f, int client_data)
966 Lisp_Object prefix, entry;
967 Lisp_Object vector;
968 Lisp_Object *subprefix_stack;
969 int submenu_depth = 0;
970 int i;
972 if (!f)
973 return;
974 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
975 vector = f->menu_bar_vector;
976 prefix = Qnil;
977 i = 0;
978 while (i < f->menu_bar_items_used)
980 if (EQ (XVECTOR (vector)->contents[i], Qnil))
982 subprefix_stack[submenu_depth++] = prefix;
983 prefix = entry;
984 i++;
986 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
988 prefix = subprefix_stack[--submenu_depth];
989 i++;
991 else if (EQ (XVECTOR (vector)->contents[i], Qt))
993 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
994 i += MENU_ITEMS_PANE_LENGTH;
996 else
998 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
999 if (client_data == i)
1001 int j;
1002 struct input_event buf;
1003 Lisp_Object frame;
1005 XSETFRAME (frame, f);
1006 buf.kind = MENU_BAR_EVENT;
1007 buf.frame_or_window = frame;
1008 buf.arg = frame;
1009 kbd_buffer_store_event (&buf);
1011 for (j = 0; j < submenu_depth; j++)
1012 if (!NILP (subprefix_stack[j]))
1014 buf.kind = MENU_BAR_EVENT;
1015 buf.frame_or_window = frame;
1016 buf.arg = subprefix_stack[j];
1017 kbd_buffer_store_event (&buf);
1020 if (!NILP (prefix))
1022 buf.kind = MENU_BAR_EVENT;
1023 buf.frame_or_window = frame;
1024 buf.arg = prefix;
1025 kbd_buffer_store_event (&buf);
1028 buf.kind = MENU_BAR_EVENT;
1029 buf.frame_or_window = frame;
1030 buf.arg = entry;
1031 kbd_buffer_store_event (&buf);
1033 #if 0
1034 /* Queue this to recompute possibly updated menubar. */
1035 buf.kind = menu_bar_activate_event;
1036 buf.frame_or_window = frame;
1037 buf.arg = Qnil;
1038 kbd_buffer_store_event (&buf);
1039 #endif
1041 return;
1043 i += MENU_ITEMS_ITEM_LENGTH;
1048 /* Allocate a widget_value, blocking input. */
1050 widget_value *
1051 xmalloc_widget_value ()
1053 widget_value *value;
1055 BLOCK_INPUT;
1056 value = malloc_widget_value ();
1057 UNBLOCK_INPUT;
1059 return value;
1062 /* This recursively calls free_widget_value on the tree of widgets.
1063 It must free all data that was malloc'ed for these widget_values.
1064 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1065 must be left alone. */
1067 void
1068 free_menubar_widget_value_tree (wv)
1069 widget_value *wv;
1071 if (! wv) return;
1073 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1075 if (wv->contents && (wv->contents != (widget_value*)1))
1077 free_menubar_widget_value_tree (wv->contents);
1078 wv->contents = (widget_value *) 0xDEADBEEF;
1080 if (wv->next)
1082 free_menubar_widget_value_tree (wv->next);
1083 wv->next = (widget_value *) 0xDEADBEEF;
1085 BLOCK_INPUT;
1086 free_widget_value (wv);
1087 UNBLOCK_INPUT;
1090 /* Return a tree of widget_value structures for a menu bar item
1091 whose event type is ITEM_KEY (with string ITEM_NAME)
1092 and whose contents come from the list of keymaps MAPS. */
1094 static widget_value *
1095 single_submenu (item_key, item_name, maps)
1096 Lisp_Object item_key, item_name, maps;
1098 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1099 int i;
1100 int submenu_depth = 0;
1101 Lisp_Object length;
1102 int len;
1103 Lisp_Object *mapvec;
1104 widget_value **submenu_stack;
1105 int previous_items = menu_items_used;
1106 int top_level_items = 0;
1108 length = Flength (maps);
1109 len = XINT (length);
1111 /* Convert the list MAPS into a vector MAPVEC. */
1112 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1113 for (i = 0; i < len; i++)
1115 mapvec[i] = Fcar (maps);
1116 maps = Fcdr (maps);
1119 menu_items_n_panes = 0;
1121 /* Loop over the given keymaps, making a pane for each map.
1122 But don't make a pane that is empty--ignore that map instead. */
1123 for (i = 0; i < len; i++)
1125 if (SYMBOLP (mapvec[i])
1126 || (CONSP (mapvec[i])
1127 && NILP (Fkeymapp (mapvec[i]))))
1129 /* Here we have a command at top level in the menu bar
1130 as opposed to a submenu. */
1131 top_level_items = 1;
1132 push_menu_pane (Qnil, Qnil);
1133 push_menu_item (item_name, Qt, item_key, mapvec[i],
1134 Qnil, Qnil, Qnil, Qnil);
1136 else
1137 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1140 /* Create a tree of widget_value objects
1141 representing the panes and their items. */
1143 submenu_stack
1144 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1145 wv = xmalloc_widget_value ();
1146 wv->name = "menu";
1147 wv->value = 0;
1148 wv->enabled = 1;
1149 wv->button_type = BUTTON_TYPE_NONE;
1150 first_wv = wv;
1151 save_wv = 0;
1152 prev_wv = 0;
1154 /* Loop over all panes and items made during this call
1155 and construct a tree of widget_value objects.
1156 Ignore the panes and items made by previous calls to
1157 single_submenu, even though those are also in menu_items. */
1158 i = previous_items;
1159 while (i < menu_items_used)
1161 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1163 submenu_stack[submenu_depth++] = save_wv;
1164 save_wv = prev_wv;
1165 prev_wv = 0;
1166 i++;
1168 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1170 prev_wv = save_wv;
1171 save_wv = submenu_stack[--submenu_depth];
1172 i++;
1174 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1175 && submenu_depth != 0)
1176 i += MENU_ITEMS_PANE_LENGTH;
1177 /* Ignore a nil in the item list.
1178 It's meaningful only for dialog boxes. */
1179 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1180 i += 1;
1181 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1183 /* Create a new pane. */
1184 Lisp_Object pane_name, prefix;
1185 char *pane_string;
1186 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1187 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1188 #ifndef HAVE_MULTILINGUAL_MENU
1189 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1190 pane_name = string_make_unibyte (pane_name);
1191 #endif
1192 pane_string = (NILP (pane_name)
1193 ? "" : (char *) XSTRING (pane_name)->data);
1194 /* If there is just one top-level pane, put all its items directly
1195 under the top-level menu. */
1196 if (menu_items_n_panes == 1)
1197 pane_string = "";
1199 /* If the pane has a meaningful name,
1200 make the pane a top-level menu item
1201 with its items as a submenu beneath it. */
1202 if (strcmp (pane_string, ""))
1204 wv = xmalloc_widget_value ();
1205 if (save_wv)
1206 save_wv->next = wv;
1207 else
1208 first_wv->contents = wv;
1209 wv->name = pane_string;
1210 /* Ignore the @ that means "separate pane".
1211 This is a kludge, but this isn't worth more time. */
1212 if (!NILP (prefix) && wv->name[0] == '@')
1213 wv->name++;
1214 wv->value = 0;
1215 wv->enabled = 1;
1216 wv->button_type = BUTTON_TYPE_NONE;
1218 save_wv = wv;
1219 prev_wv = 0;
1220 i += MENU_ITEMS_PANE_LENGTH;
1222 else
1224 /* Create a new item within current pane. */
1225 Lisp_Object item_name, enable, descrip, def, type, selected;
1226 Lisp_Object help;
1228 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1229 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1230 descrip
1231 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1232 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1233 type = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_TYPE];
1234 selected = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_SELECTED];
1235 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1237 #ifndef HAVE_MULTILINGUAL_MENU
1238 if (STRING_MULTIBYTE (item_name))
1239 item_name = string_make_unibyte (item_name);
1240 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1241 descrip = string_make_unibyte (descrip);
1242 #endif
1244 wv = xmalloc_widget_value ();
1245 if (prev_wv)
1246 prev_wv->next = wv;
1247 else
1248 save_wv->contents = wv;
1250 wv->name = (char *) XSTRING (item_name)->data;
1251 if (!NILP (descrip))
1252 wv->key = (char *) XSTRING (descrip)->data;
1253 wv->value = 0;
1254 /* The EMACS_INT cast avoids a warning. There's no problem
1255 as long as pointers have enough bits to hold small integers. */
1256 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1257 wv->enabled = !NILP (enable);
1259 if (NILP (type))
1260 wv->button_type = BUTTON_TYPE_NONE;
1261 else if (EQ (type, QCradio))
1262 wv->button_type = BUTTON_TYPE_RADIO;
1263 else if (EQ (type, QCtoggle))
1264 wv->button_type = BUTTON_TYPE_TOGGLE;
1265 else
1266 abort ();
1268 wv->selected = !NILP (selected);
1269 if (STRINGP (help))
1270 wv->help = (char *) XSTRING (help)->data;
1271 else
1272 wv->help = NULL;
1274 prev_wv = wv;
1276 i += MENU_ITEMS_ITEM_LENGTH;
1280 /* If we have just one "menu item"
1281 that was originally a button, return it by itself. */
1282 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1284 wv = first_wv->contents;
1285 free_widget_value (first_wv);
1286 return wv;
1289 return first_wv;
1292 /* Set the contents of the menubar widgets of frame F.
1293 The argument FIRST_TIME is currently ignored;
1294 it is set the first time this is called, from initialize_frame_menubar. */
1296 void
1297 set_frame_menubar (f, first_time, deep_p)
1298 FRAME_PTR f;
1299 int first_time;
1300 int deep_p;
1302 int menubar_widget = f->output_data.mac->menubar_widget;
1303 Lisp_Object items;
1304 widget_value *wv, *first_wv, *prev_wv = 0;
1305 int i;
1307 XSETFRAME (Vmenu_updating_frame, f);
1309 wv = xmalloc_widget_value ();
1310 wv->name = "menubar";
1311 wv->value = 0;
1312 wv->enabled = 1;
1313 wv->button_type = BUTTON_TYPE_NONE;
1314 first_wv = wv;
1317 /* Make a widget-value tree representing the entire menu trees. */
1319 struct buffer *prev = current_buffer;
1320 Lisp_Object buffer;
1321 int specpdl_count = specpdl_ptr - specpdl;
1322 int previous_menu_items_used = f->menu_bar_items_used;
1323 Lisp_Object *previous_items
1324 = (Lisp_Object *) alloca (previous_menu_items_used
1325 * sizeof (Lisp_Object));
1327 /* If we are making a new widget, its contents are empty,
1328 do always reinitialize them. */
1329 if (! menubar_widget)
1330 previous_menu_items_used = 0;
1332 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1333 specbind (Qinhibit_quit, Qt);
1334 /* Don't let the debugger step into this code
1335 because it is not reentrant. */
1336 specbind (Qdebug_on_next_call, Qnil);
1338 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1339 if (NILP (Voverriding_local_map_menu_flag))
1341 specbind (Qoverriding_terminal_local_map, Qnil);
1342 specbind (Qoverriding_local_map, Qnil);
1345 set_buffer_internal_1 (XBUFFER (buffer));
1347 /* Run the Lucid hook. */
1348 call1 (Vrun_hooks, Qactivate_menubar_hook);
1349 /* If it has changed current-menubar from previous value,
1350 really recompute the menubar from the value. */
1351 if (! NILP (Vlucid_menu_bar_dirty_flag))
1352 call0 (Qrecompute_lucid_menubar);
1353 safe_run_hooks (Qmenu_bar_update_hook);
1354 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1356 items = FRAME_MENU_BAR_ITEMS (f);
1358 inhibit_garbage_collection ();
1360 /* Save the frame's previous menu bar contents data. */
1361 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1362 previous_menu_items_used * sizeof (Lisp_Object));
1364 /* Fill in the current menu bar contents. */
1365 menu_items = f->menu_bar_vector;
1366 menu_items_allocated = XVECTOR (menu_items)->size;
1367 init_menu_items ();
1368 for (i = 0; i < XVECTOR (items)->size; i += 4)
1370 Lisp_Object key, string, maps;
1372 key = XVECTOR (items)->contents[i];
1373 string = XVECTOR (items)->contents[i + 1];
1374 maps = XVECTOR (items)->contents[i + 2];
1375 if (NILP (string))
1376 break;
1378 wv = single_submenu (key, string, maps);
1379 if (prev_wv)
1380 prev_wv->next = wv;
1381 else
1382 first_wv->contents = wv;
1383 /* Don't set wv->name here; GC during the loop might relocate it. */
1384 wv->enabled = 1;
1385 wv->button_type = BUTTON_TYPE_NONE;
1386 prev_wv = wv;
1389 finish_menu_items ();
1391 set_buffer_internal_1 (prev);
1392 unbind_to (specpdl_count, Qnil);
1394 /* If there has been no change in the Lisp-level contents
1395 of the menu bar, skip redisplaying it. Just exit. */
1397 for (i = 0; i < previous_menu_items_used; i++)
1398 if (menu_items_used == i
1399 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1400 break;
1401 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1403 free_menubar_widget_value_tree (first_wv);
1404 menu_items = Qnil;
1406 return;
1409 /* Now GC cannot happen during the lifetime of the widget_value,
1410 so it's safe to store data from a Lisp_String. */
1411 wv = first_wv->contents;
1412 for (i = 0; i < XVECTOR (items)->size; i += 4)
1414 Lisp_Object string;
1415 string = XVECTOR (items)->contents[i + 1];
1416 if (NILP (string))
1417 break;
1418 wv->name = (char *) XSTRING (string)->data;
1419 wv = wv->next;
1422 f->menu_bar_vector = menu_items;
1423 f->menu_bar_items_used = menu_items_used;
1424 menu_items = Qnil;
1427 /* Create or update the menu bar widget. */
1429 BLOCK_INPUT;
1431 f->output_data.mac->menubar_widget = NULL; /* always NULL on Mac */
1434 int i = MIN_MENU_ID;
1435 MenuHandle menu = GetMenuHandle (i);
1436 while (menu != NULL)
1438 DeleteMenu (i);
1439 DisposeMenu (menu);
1440 menu = GetMenuHandle (++i);
1443 i = MIN_SUBMENU_ID;
1444 menu = GetMenuHandle (i);
1445 while (menu != NULL)
1447 DeleteMenu (i);
1448 DisposeMenu (menu);
1449 menu = GetMenuHandle (++i);
1453 fill_menubar (first_wv->contents);
1455 DrawMenuBar ();
1457 free_menubar_widget_value_tree (first_wv);
1459 UNBLOCK_INPUT;
1462 /* Called from Fx_create_frame to create the initial menubar of a
1463 frame before it is mapped, so that the window is mapped with the
1464 menubar already there instead of us tacking it on later and
1465 thrashing the window after it is visible. */
1467 void
1468 initialize_frame_menubar (f)
1469 FRAME_PTR f;
1471 /* This function is called before the first chance to redisplay
1472 the frame. It has to be, so the frame will have the right size. */
1473 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1474 set_frame_menubar (f, 1, 1);
1477 /* Get rid of the menu bar of frame F, and free its storage.
1478 This is used when deleting a frame, and when turning off the menu bar. */
1480 void
1481 free_frame_menubar (f)
1482 FRAME_PTR f;
1484 /* Nothing to do since set_frame_menubar disposes of menus before
1485 installing new ones. */
1489 /* mac_menu_show actually displays a menu using the panes and items in
1490 menu_items and returns the value selected from it; we assume input
1491 is blocked by the caller. */
1493 /* F is the frame the menu is for.
1494 X and Y are the frame-relative specified position,
1495 relative to the inside upper left corner of the frame F.
1496 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1497 KEYMAPS is 1 if this menu was specified with keymaps;
1498 in that case, we return a list containing the chosen item's value
1499 and perhaps also the pane's prefix.
1500 TITLE is the specified menu title.
1501 ERROR is a place to store an error message string in case of failure.
1502 (We return nil on failure, but the value doesn't actually matter.) */
1504 static Lisp_Object
1505 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1506 FRAME_PTR f;
1507 int x;
1508 int y;
1509 int for_click;
1510 int keymaps;
1511 Lisp_Object title;
1512 char **error;
1514 int i;
1515 int menu_item_selection;
1516 MenuHandle menu;
1517 Point pos;
1518 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1519 widget_value **submenu_stack
1520 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1521 Lisp_Object *subprefix_stack
1522 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1523 int submenu_depth = 0;
1524 int first_pane;
1525 int next_release_must_exit = 0;
1527 *error = NULL;
1529 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1531 *error = "Empty menu";
1532 return Qnil;
1535 /* Create a tree of widget_value objects
1536 representing the panes and their items. */
1537 wv = xmalloc_widget_value ();
1538 wv->name = "menu";
1539 wv->value = 0;
1540 wv->enabled = 1;
1541 wv->button_type = BUTTON_TYPE_NONE;
1542 first_wv = wv;
1543 first_pane = 1;
1545 /* Loop over all panes and items, filling in the tree. */
1546 i = 0;
1547 while (i < menu_items_used)
1549 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1551 submenu_stack[submenu_depth++] = save_wv;
1552 save_wv = prev_wv;
1553 prev_wv = 0;
1554 first_pane = 1;
1555 i++;
1557 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1559 prev_wv = save_wv;
1560 save_wv = submenu_stack[--submenu_depth];
1561 first_pane = 0;
1562 i++;
1564 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1565 && submenu_depth != 0)
1566 i += MENU_ITEMS_PANE_LENGTH;
1567 /* Ignore a nil in the item list.
1568 It's meaningful only for dialog boxes. */
1569 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1570 i += 1;
1571 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1573 /* Create a new pane. */
1574 Lisp_Object pane_name, prefix;
1575 char *pane_string;
1576 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1577 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1578 #ifndef HAVE_MULTILINGUAL_MENU
1579 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1580 pane_name = string_make_unibyte (pane_name);
1581 #endif
1582 pane_string = (NILP (pane_name)
1583 ? "" : (char *) XSTRING (pane_name)->data);
1584 /* If there is just one top-level pane, put all its items directly
1585 under the top-level menu. */
1586 if (menu_items_n_panes == 1)
1587 pane_string = "";
1589 /* If the pane has a meaningful name,
1590 make the pane a top-level menu item
1591 with its items as a submenu beneath it. */
1592 if (!keymaps && strcmp (pane_string, ""))
1594 wv = xmalloc_widget_value ();
1595 if (save_wv)
1596 save_wv->next = wv;
1597 else
1598 first_wv->contents = wv;
1599 wv->name = pane_string;
1600 if (keymaps && !NILP (prefix))
1601 wv->name++;
1602 wv->value = 0;
1603 wv->enabled = 1;
1604 wv->button_type = BUTTON_TYPE_NONE;
1605 save_wv = wv;
1606 prev_wv = 0;
1608 else if (first_pane)
1610 save_wv = wv;
1611 prev_wv = 0;
1613 first_pane = 0;
1614 i += MENU_ITEMS_PANE_LENGTH;
1616 else
1618 /* Create a new item within current pane. */
1619 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1621 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1622 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1623 descrip
1624 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1625 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1626 type = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_TYPE];
1627 selected = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_SELECTED];
1628 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1630 #ifndef HAVE_MULTILINGUAL_MENU
1631 if (STRING_MULTIBYTE (item_name))
1632 item_name = string_make_unibyte (item_name);
1633 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1634 descrip = string_make_unibyte (descrip);
1635 #endif
1637 wv = xmalloc_widget_value ();
1638 if (prev_wv)
1639 prev_wv->next = wv;
1640 else
1641 save_wv->contents = wv;
1642 wv->name = (char *) XSTRING (item_name)->data;
1643 if (!NILP (descrip))
1644 wv->key = (char *) XSTRING (descrip)->data;
1645 wv->value = 0;
1646 /* Use the contents index as call_data, since we are
1647 restricted to 16-bits.. */
1648 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1649 wv->enabled = !NILP (enable);
1651 if (NILP (type))
1652 wv->button_type = BUTTON_TYPE_NONE;
1653 else if (EQ (type, QCtoggle))
1654 wv->button_type = BUTTON_TYPE_TOGGLE;
1655 else if (EQ (type, QCradio))
1656 wv->button_type = BUTTON_TYPE_RADIO;
1657 else
1658 abort ();
1660 wv->selected = !NILP (selected);
1662 if (STRINGP (help))
1663 wv->help = (char *) XSTRING (help)->data;
1664 else
1665 wv->help = NULL;
1667 prev_wv = wv;
1669 i += MENU_ITEMS_ITEM_LENGTH;
1673 /* Deal with the title, if it is non-nil. */
1674 if (!NILP (title))
1676 widget_value *wv_title = xmalloc_widget_value ();
1677 widget_value *wv_sep = xmalloc_widget_value ();
1679 /* Maybe replace this separator with a bitmap or owner-draw item
1680 so that it looks better. Having two separators looks odd. */
1681 wv_sep->name = "--";
1682 wv_sep->next = first_wv->contents;
1684 #ifndef HAVE_MULTILINGUAL_MENU
1685 if (STRING_MULTIBYTE (title))
1686 title = string_make_unibyte (title);
1687 #endif
1688 wv_title->name = (char *) XSTRING (title)->data;
1689 wv_title->enabled = True;
1690 wv_title->button_type = BUTTON_TYPE_NONE;
1691 wv_title->next = wv_sep;
1692 first_wv->contents = wv_title;
1695 /* Actually create the menu. */
1696 menu = NewMenu (POPUP_SUBMENU_ID, "\p");
1697 fill_submenu (menu, first_wv->contents, 0);
1699 /* Adjust coordinates to be root-window-relative. */
1700 pos.h = x;
1701 pos.v = y;
1702 SetPort (FRAME_MAC_WINDOW (f));
1703 LocalToGlobal (&pos);
1705 /* No selection has been chosen yet. */
1706 menu_item_selection = 0;
1708 InsertMenu (menu, -1);
1710 /* Display the menu. */
1711 menu_item_selection = LoWord (PopUpMenuSelect (menu, pos.v, pos.h, 0));
1713 DeleteMenu (POPUP_SUBMENU_ID);
1715 #if 0
1716 /* Clean up extraneous mouse events which might have been generated
1717 during the call. */
1718 discard_mouse_events ();
1719 #endif
1721 /* Free the widget_value objects we used to specify the
1722 contents. */
1723 free_menubar_widget_value_tree (first_wv);
1725 DisposeMenu (menu);
1727 /* Find the selected item, and its pane, to return the proper
1728 value. */
1729 if (menu_item_selection != 0)
1731 Lisp_Object prefix, entry;
1733 prefix = Qnil;
1734 i = 0;
1735 while (i < menu_items_used)
1737 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1739 subprefix_stack[submenu_depth++] = prefix;
1740 prefix = entry;
1741 i++;
1743 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1745 prefix = subprefix_stack[--submenu_depth];
1746 i++;
1748 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1750 prefix
1751 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1752 i += MENU_ITEMS_PANE_LENGTH;
1754 /* Ignore a nil in the item list. It's meaningful only for
1755 dialog boxes. */
1756 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1757 i += 1;
1758 else
1760 entry
1761 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1762 if (menu_item_selection == i)
1764 if (keymaps != 0)
1766 int j;
1768 entry = Fcons (entry, Qnil);
1769 if (!NILP (prefix))
1770 entry = Fcons (prefix, entry);
1771 for (j = submenu_depth - 1; j >= 0; j--)
1772 if (!NILP (subprefix_stack[j]))
1773 entry = Fcons (subprefix_stack[j], entry);
1775 return entry;
1777 i += MENU_ITEMS_ITEM_LENGTH;
1782 return Qnil;
1786 /* Construct native Mac OS menubar based on widget_value tree. */
1788 static int
1789 mac_dialog (widget_value *wv)
1791 char *dialog_name;
1792 char *prompt;
1793 char **button_labels;
1794 UInt32 *ref_cons;
1795 int nb_buttons;
1796 int left_count;
1797 int i;
1798 int dialog_width;
1799 Rect rect;
1800 WindowPtr window_ptr;
1801 ControlHandle ch;
1802 int left;
1803 EventRecord event_record;
1804 SInt16 part_code;
1805 int control_part_code;
1806 Point mouse;
1808 dialog_name = wv->name;
1809 nb_buttons = dialog_name[1] - '0';
1810 left_count = nb_buttons - (dialog_name[4] - '0');
1811 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
1812 ref_cons = (int *) alloca (sizeof (UInt32) * nb_buttons);
1814 wv = wv->contents;
1815 prompt = (char *) alloca (strlen (wv->value) + 1);
1816 strcpy (prompt, wv->value);
1817 c2pstr (prompt);
1819 wv = wv->next;
1820 for (i = 0; i < nb_buttons; i++)
1822 button_labels[i] = wv->value;
1823 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
1824 strcpy (button_labels[i], wv->value);
1825 c2pstr (button_labels[i]);
1826 ref_cons[i] = (UInt32) wv->call_data;
1827 wv = wv->next;
1830 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
1831 SetPort (window_ptr);
1833 TextFont (0);
1834 /* Left and right margins in the dialog are 13 pixels each.*/
1835 dialog_width = 14;
1836 /* Calculate width of dialog box: 8 pixels on each side of the text
1837 label in each button, 12 pixels between buttons. */
1838 for (i = 0; i < nb_buttons; i++)
1839 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
1841 if (left_count != 0 && nb_buttons - left_count != 0)
1842 dialog_width += 12;
1844 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
1846 SizeWindow (window_ptr, dialog_width, 78, 0);
1847 ShowWindow (window_ptr);
1849 SetPort (window_ptr);
1850 TextFont (0);
1852 MoveTo (13, 29);
1853 DrawString (prompt);
1855 left = 13;
1856 for (i = 0; i < nb_buttons; i++)
1858 int button_width = StringWidth (button_labels[i]) + 16;
1859 SetRect (&rect, left, 45, left + button_width, 65);
1860 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
1861 kControlPushButtonProc, ref_cons[i]);
1862 left += button_width + 12;
1863 if (i == left_count - 1)
1864 left += 12;
1867 i = 0;
1868 while (!i)
1870 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
1871 if (event_record.what == mouseDown)
1873 part_code = FindWindow (event_record.where, &window_ptr);
1874 if (part_code == inContent)
1876 mouse = event_record.where;
1877 GlobalToLocal (&mouse);
1878 control_part_code = FindControl (mouse, window_ptr, &ch);
1879 if (control_part_code == kControlButtonPart)
1880 if (TrackControl (ch, mouse, NULL))
1881 i = GetControlReference (ch);
1886 DisposeWindow (window_ptr);
1888 return i;
1891 static char * button_names [] = {
1892 "button1", "button2", "button3", "button4", "button5",
1893 "button6", "button7", "button8", "button9", "button10" };
1895 static Lisp_Object
1896 mac_dialog_show (f, keymaps, title, error)
1897 FRAME_PTR f;
1898 int keymaps;
1899 Lisp_Object title;
1900 char **error;
1902 int i, nb_buttons=0;
1903 char dialog_name[6];
1904 int menu_item_selection;
1906 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1908 /* Number of elements seen so far, before boundary. */
1909 int left_count = 0;
1910 /* 1 means we've seen the boundary between left-hand elts and
1911 right-hand. */
1912 int boundary_seen = 0;
1914 *error = NULL;
1916 if (menu_items_n_panes > 1)
1918 *error = "Multiple panes in dialog box";
1919 return Qnil;
1922 /* Create a tree of widget_value objects representing the text label
1923 and buttons. */
1925 Lisp_Object pane_name, prefix;
1926 char *pane_string;
1927 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1928 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1929 pane_string = (NILP (pane_name)
1930 ? "" : (char *) XSTRING (pane_name)->data);
1931 prev_wv = xmalloc_widget_value ();
1932 prev_wv->value = pane_string;
1933 if (keymaps && !NILP (prefix))
1934 prev_wv->name++;
1935 prev_wv->enabled = 1;
1936 prev_wv->name = "message";
1937 first_wv = prev_wv;
1939 /* Loop over all panes and items, filling in the tree. */
1940 i = MENU_ITEMS_PANE_LENGTH;
1941 while (i < menu_items_used)
1944 /* Create a new item within current pane. */
1945 Lisp_Object item_name, enable, descrip, help;
1947 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1948 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1949 descrip
1950 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1951 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1953 if (NILP (item_name))
1955 free_menubar_widget_value_tree (first_wv);
1956 *error = "Submenu in dialog items";
1957 return Qnil;
1959 if (EQ (item_name, Qquote))
1961 /* This is the boundary between left-side elts and
1962 right-side elts. Stop incrementing right_count. */
1963 boundary_seen = 1;
1964 i++;
1965 continue;
1967 if (nb_buttons >= 9)
1969 free_menubar_widget_value_tree (first_wv);
1970 *error = "Too many dialog items";
1971 return Qnil;
1974 wv = xmalloc_widget_value ();
1975 prev_wv->next = wv;
1976 wv->name = (char *) button_names[nb_buttons];
1977 if (!NILP (descrip))
1978 wv->key = (char *) XSTRING (descrip)->data;
1979 wv->value = (char *) XSTRING (item_name)->data;
1980 wv->call_data = (void *) i;
1981 /* menu item is identified by its index in menu_items table */
1982 wv->enabled = !NILP (enable);
1983 prev_wv = wv;
1985 if (! boundary_seen)
1986 left_count++;
1988 nb_buttons++;
1989 i += MENU_ITEMS_ITEM_LENGTH;
1992 /* If the boundary was not specified, by default put half on the
1993 left and half on the right. */
1994 if (! boundary_seen)
1995 left_count = nb_buttons - nb_buttons / 2;
1997 wv = xmalloc_widget_value ();
1998 wv->name = dialog_name;
2000 /* Dialog boxes use a really stupid name encoding which specifies
2001 how many buttons to use and how many buttons are on the right.
2002 The Q means something also. */
2003 dialog_name[0] = 'Q';
2004 dialog_name[1] = '0' + nb_buttons;
2005 dialog_name[2] = 'B';
2006 dialog_name[3] = 'R';
2007 /* Number of buttons to put on the right. */
2008 dialog_name[4] = '0' + nb_buttons - left_count;
2009 dialog_name[5] = 0;
2010 wv->contents = first_wv;
2011 first_wv = wv;
2014 /* Actually create the dialog. */
2015 #ifdef HAVE_DIALOGS
2016 menu_item_selection = mac_dialog (first_wv);
2017 #else
2018 menu_item_selection = 0;
2019 #endif
2021 /* Free the widget_value objects we used to specify the
2022 contents. */
2023 free_menubar_widget_value_tree (first_wv);
2025 /* Find the selected item, and its pane, to return the proper
2026 value. */
2027 if (menu_item_selection != 0)
2029 Lisp_Object prefix;
2031 prefix = Qnil;
2032 i = 0;
2033 while (i < menu_items_used)
2035 Lisp_Object entry;
2037 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2039 prefix
2040 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2041 i += MENU_ITEMS_PANE_LENGTH;
2043 else
2045 entry
2046 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2047 if (menu_item_selection == i)
2049 if (keymaps != 0)
2051 entry = Fcons (entry, Qnil);
2052 if (!NILP (prefix))
2053 entry = Fcons (prefix, entry);
2055 return entry;
2057 i += MENU_ITEMS_ITEM_LENGTH;
2062 return Qnil;
2066 /* Is this item a separator? */
2067 static int
2068 name_is_separator (name)
2069 char *name;
2071 /* Check if name string consists of only dashes ('-') */
2072 while (*name == '-') name++;
2073 return (*name == '\0');
2076 static void
2077 add_menu_item (MenuHandle menu, widget_value *wv, int submenu, int indent,
2078 int force_disable)
2080 Str255 item_name;
2081 int pos, i;
2083 if (name_is_separator (wv->name))
2084 AppendMenu (menu, "\p-");
2085 else
2087 AppendMenu (menu, "\pX");
2089 pos = CountMItems (menu);
2091 strcpy (item_name, "");
2092 for (i = 0; i < indent; i++)
2093 strcat (item_name, " ");
2094 strcat (item_name, wv->name);
2095 if (wv->key != NULL)
2097 strcat (item_name, " ");
2098 strcat (item_name, wv->key);
2100 c2pstr (item_name);
2101 SetMenuItemText (menu, pos, item_name);
2103 if (wv->enabled && !force_disable)
2104 EnableItem (menu, pos);
2105 else
2106 DisableItem (menu, pos);
2108 /* Draw radio buttons and tickboxes. */
2110 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2111 wv->button_type == BUTTON_TYPE_RADIO))
2112 SetItemMark (menu, pos, checkMark);
2113 else
2114 SetItemMark (menu, pos, noMark);
2118 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
2120 if (submenu != NULL)
2121 SetMenuItemHierarchicalID (menu, pos, submenu);
2124 static int submenu_id;
2126 /* Construct native Mac OS menubar based on widget_value tree. */
2128 static void
2129 fill_submenu (MenuHandle menu, widget_value *wv, int indent)
2131 for ( ; wv != NULL; wv = wv->next)
2132 if (wv->contents)
2134 add_menu_item (menu, wv, NULL, indent, 1);
2136 fill_submenu (menu, wv->contents, indent + 1);
2138 else
2139 add_menu_item (menu, wv, NULL, indent, 0);
2143 /* Construct native Mac OS menu based on widget_value tree. */
2145 static void
2146 fill_menu (MenuHandle menu, widget_value *wv)
2148 for ( ; wv != NULL; wv = wv->next)
2149 if (wv->contents)
2151 MenuHandle submenu = NewMenu (submenu_id, "\pX");
2152 fill_submenu (submenu, wv->contents, 0);
2153 InsertMenu (submenu, -1);
2154 add_menu_item (menu, wv, submenu_id, 0, 0);
2155 submenu_id++;
2157 else
2158 add_menu_item (menu, wv, NULL, 0, 0);
2161 /* Construct native Mac OS menubar based on widget_value tree. */
2163 static void
2164 fill_menubar (widget_value *wv)
2166 int id;
2168 submenu_id = MIN_SUBMENU_ID;
2170 for (id = MIN_MENU_ID; wv != NULL; wv = wv->next, id++)
2172 MenuHandle menu;
2173 Str255 title;
2175 strcpy (title, wv->name);
2176 c2pstr (title);
2177 menu = NewMenu (id, title);
2179 if (wv->contents)
2180 fill_menu (menu, wv->contents);
2182 InsertMenu (menu, 0);
2186 #endif /* HAVE_MENUS */
2188 void
2189 syms_of_macmenu ()
2191 staticpro (&menu_items);
2192 menu_items = Qnil;
2194 Qdebug_on_next_call = intern ("debug-on-next-call");
2195 staticpro (&Qdebug_on_next_call);
2197 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2198 "Frame for which we are updating a menu.\n\
2199 The enable predicate for a menu command should check this variable.");
2200 Vmenu_updating_frame = Qnil;
2202 defsubr (&Sx_popup_menu);
2203 #ifdef HAVE_MENUS
2204 defsubr (&Sx_popup_dialog);
2205 #endif