(sentence-end-double-space, sentence-end-without-period): Move to paragraphs.
[emacs.git] / mac / src / macmenu.c
blobb7ed55adcecf627a70e73cee69aa74fe40adbd79
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"
36 #include "keymap.h"
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__) || defined (CODEWARRIOR_VERSION_6)
47 #include <ControlDefinitions.h>
48 #endif
50 /* This may include sys/types.h, and that somehow loses
51 if this is not done before the other system files. */
52 #include "macterm.h"
54 /* Load sys/types.h if not already loaded.
55 In some systems loading it twice is suicidal. */
56 #ifndef makedev
57 #include <sys/types.h>
58 #endif
60 #include "dispextern.h"
62 #define POPUP_SUBMENU_ID 235
63 #define MIN_MENU_ID 256
64 #define MIN_SUBMENU_ID 1
66 #define DIALOG_WINDOW_RESOURCE 130
68 #define HAVE_DIALOGS 1
70 #undef HAVE_MULTILINGUAL_MENU
72 /******************************************************************/
73 /* Definitions copied from lwlib.h */
75 typedef void * XtPointer;
77 #define True 1
78 #define False 0
80 enum button_type
82 BUTTON_TYPE_NONE,
83 BUTTON_TYPE_TOGGLE,
84 BUTTON_TYPE_RADIO
87 typedef struct _widget_value
89 /* name of widget */
90 char* name;
91 /* value (meaning depend on widget type) */
92 char* value;
93 /* keyboard equivalent. no implications for XtTranslations */
94 char* key;
95 /* Help string or null if none. */
96 char *help;
97 /* true if enabled */
98 Boolean enabled;
99 /* true if selected */
100 Boolean selected;
101 /* The type of a button. */
102 enum button_type button_type;
103 /* true if menu title */
104 Boolean title;
105 #if 0
106 /* true if was edited (maintained by get_value) */
107 Boolean edited;
108 /* true if has changed (maintained by lw library) */
109 change_type change;
110 /* true if this widget itself has changed,
111 but not counting the other widgets found in the `next' field. */
112 change_type this_one_change;
113 #endif
114 /* Contents of the sub-widgets, also selected slot for checkbox */
115 struct _widget_value* contents;
116 /* data passed to callback */
117 XtPointer call_data;
118 /* next one in the list */
119 struct _widget_value* next;
120 #if 0
121 /* slot for the toolkit dependent part. Always initialize to NULL. */
122 void* toolkit_data;
123 /* tell us if we should free the toolkit data slot when freeing the
124 widget_value itself. */
125 Boolean free_toolkit_data;
127 /* we resource the widget_value structures; this points to the next
128 one on the free list if this one has been deallocated.
130 struct _widget_value *free_list;
131 #endif
132 } widget_value;
134 /* Assumed by other routines to zero area returned. */
135 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
136 0, (sizeof (widget_value)))
137 #define free_widget_value(wv) xfree (wv)
139 /******************************************************************/
141 #define min(x,y) (((x) < (y)) ? (x) : (y))
142 #define max(x,y) (((x) > (y)) ? (x) : (y))
144 #ifndef TRUE
145 #define TRUE 1
146 #define FALSE 0
147 #endif /* no TRUE */
149 Lisp_Object Vmenu_updating_frame;
151 Lisp_Object Qdebug_on_next_call;
153 extern Lisp_Object Qmenu_bar;
154 extern Lisp_Object Qmouse_click, Qevent_kind;
156 extern Lisp_Object QCtoggle, QCradio;
158 extern Lisp_Object Voverriding_local_map;
159 extern Lisp_Object Voverriding_local_map_menu_flag;
161 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
163 extern Lisp_Object Qmenu_bar_update_hook;
165 void set_frame_menubar ();
167 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
168 Lisp_Object, Lisp_Object, Lisp_Object,
169 Lisp_Object, Lisp_Object));
170 static Lisp_Object mac_dialog_show ();
171 static Lisp_Object mac_menu_show ();
173 static void keymap_panes ();
174 static void single_keymap_panes ();
175 static void single_menu_item ();
176 static void list_of_panes ();
177 static void list_of_items ();
179 static void fill_submenu (MenuHandle, widget_value *, int);
180 static void fill_menubar (widget_value *);
183 /* This holds a Lisp vector that holds the results of decoding
184 the keymaps or alist-of-alists that specify a menu.
186 It describes the panes and items within the panes.
188 Each pane is described by 3 elements in the vector:
189 t, the pane name, the pane's prefix key.
190 Then follow the pane's items, with 5 elements per item:
191 the item string, the enable flag, the item's value,
192 the definition, and the equivalent keyboard key's description string.
194 In some cases, multiple levels of menus may be described.
195 A single vector slot containing nil indicates the start of a submenu.
196 A single vector slot containing lambda indicates the end of a submenu.
197 The submenu follows a menu item which is the way to reach the submenu.
199 A single vector slot containing quote indicates that the
200 following items should appear on the right of a dialog box.
202 Using a Lisp vector to hold this information while we decode it
203 takes care of protecting all the data from GC. */
205 #define MENU_ITEMS_PANE_NAME 1
206 #define MENU_ITEMS_PANE_PREFIX 2
207 #define MENU_ITEMS_PANE_LENGTH 3
209 enum menu_item_idx
211 MENU_ITEMS_ITEM_NAME = 0,
212 MENU_ITEMS_ITEM_ENABLE,
213 MENU_ITEMS_ITEM_VALUE,
214 MENU_ITEMS_ITEM_EQUIV_KEY,
215 MENU_ITEMS_ITEM_DEFINITION,
216 MENU_ITEMS_ITEM_TYPE,
217 MENU_ITEMS_ITEM_SELECTED,
218 MENU_ITEMS_ITEM_HELP,
219 MENU_ITEMS_ITEM_LENGTH
222 static Lisp_Object menu_items;
224 /* Number of slots currently allocated in menu_items. */
225 static int menu_items_allocated;
227 /* This is the index in menu_items of the first empty slot. */
228 static int menu_items_used;
230 /* The number of panes currently recorded in menu_items,
231 excluding those within submenus. */
232 static int menu_items_n_panes;
234 /* Current depth within submenus. */
235 static int menu_items_submenu_depth;
237 /* Flag which when set indicates a dialog or menu has been posted by
238 Xt on behalf of one of the widget sets. */
239 static int popup_activated_flag;
241 static int next_menubar_widget_id;
243 /* This is set nonzero after the user activates the menu bar, and set
244 to zero again after the menu bars are redisplayed by prepare_menu_bar.
245 While it is nonzero, all calls to set_frame_menubar go deep.
247 I don't understand why this is needed, but it does seem to be
248 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
250 int pending_menu_activation;
252 /* Initialize the menu_items structure if we haven't already done so.
253 Also mark it as currently empty. */
255 static void
256 init_menu_items ()
258 if (NILP (menu_items))
260 menu_items_allocated = 60;
261 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
264 menu_items_used = 0;
265 menu_items_n_panes = 0;
266 menu_items_submenu_depth = 0;
269 /* Call at the end of generating the data in menu_items.
270 This fills in the number of items in the last pane. */
272 static void
273 finish_menu_items ()
277 /* Call when finished using the data for the current menu
278 in menu_items. */
280 static void
281 discard_menu_items ()
283 /* Free the structure if it is especially large.
284 Otherwise, hold on to it, to save time. */
285 if (menu_items_allocated > 200)
287 menu_items = Qnil;
288 menu_items_allocated = 0;
292 /* Make the menu_items vector twice as large. */
294 static void
295 grow_menu_items ()
297 Lisp_Object old;
298 int old_size = menu_items_allocated;
299 old = menu_items;
301 menu_items_allocated *= 2;
302 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
303 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
304 old_size * sizeof (Lisp_Object));
307 /* Begin a submenu. */
309 static void
310 push_submenu_start ()
312 if (menu_items_used + 1 > menu_items_allocated)
313 grow_menu_items ();
315 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
316 menu_items_submenu_depth++;
319 /* End a submenu. */
321 static void
322 push_submenu_end ()
324 if (menu_items_used + 1 > menu_items_allocated)
325 grow_menu_items ();
327 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
328 menu_items_submenu_depth--;
331 /* Indicate boundary between left and right. */
333 static void
334 push_left_right_boundary ()
336 if (menu_items_used + 1 > menu_items_allocated)
337 grow_menu_items ();
339 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
342 /* Start a new menu pane in menu_items..
343 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
345 static void
346 push_menu_pane (name, prefix_vec)
347 Lisp_Object name, prefix_vec;
349 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
350 grow_menu_items ();
352 if (menu_items_submenu_depth == 0)
353 menu_items_n_panes++;
354 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
355 XVECTOR (menu_items)->contents[menu_items_used++] = name;
356 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
359 /* Push one menu item into the current pane. NAME is the string to
360 display. ENABLE if non-nil means this item can be selected. KEY
361 is the key generated by choosing this item, or nil if this item
362 doesn't really have a definition. DEF is the definition of this
363 item. EQUIV is the textual description of the keyboard equivalent
364 for this item (or nil if none). TYPE is the type of this menu
365 item, one of nil, `toggle' or `radio'. */
367 static void
368 push_menu_item (name, enable, key, def, equiv, type, selected, help)
369 Lisp_Object name, enable, key, def, equiv, type, selected, help;
371 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
372 grow_menu_items ();
374 XVECTOR (menu_items)->contents[menu_items_used++] = name;
375 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
376 XVECTOR (menu_items)->contents[menu_items_used++] = key;
377 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
378 XVECTOR (menu_items)->contents[menu_items_used++] = def;
379 XVECTOR (menu_items)->contents[menu_items_used++] = type;
380 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
381 XVECTOR (menu_items)->contents[menu_items_used++] = help;
384 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
385 and generate menu panes for them in menu_items.
386 If NOTREAL is nonzero,
387 don't bother really computing whether an item is enabled. */
389 static void
390 keymap_panes (keymaps, nmaps, notreal)
391 Lisp_Object *keymaps;
392 int nmaps;
393 int notreal;
395 int mapno;
397 init_menu_items ();
399 /* Loop over the given keymaps, making a pane for each map.
400 But don't make a pane that is empty--ignore that map instead.
401 P is the number of panes we have made so far. */
402 for (mapno = 0; mapno < nmaps; mapno++)
403 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal, 10);
405 finish_menu_items ();
408 /* This is a recursive subroutine of keymap_panes.
409 It handles one keymap, KEYMAP.
410 The other arguments are passed along
411 or point to local variables of the previous function.
412 If NOTREAL is nonzero, only check for equivalent key bindings, don't
413 evaluate expressions in menu items and don't make any menu.
415 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
417 static void
418 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
419 Lisp_Object keymap;
420 Lisp_Object pane_name;
421 Lisp_Object prefix;
422 int notreal;
423 int maxdepth;
425 Lisp_Object pending_maps = Qnil;
426 Lisp_Object tail, item;
427 struct gcpro gcpro1, gcpro2;
429 if (maxdepth <= 0)
430 return;
432 push_menu_pane (pane_name, prefix);
434 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
436 GCPRO2 (keymap, pending_maps);
437 /* Look at each key binding, and if it is a menu item add it
438 to this menu. */
439 item = XCAR (tail);
440 if (CONSP (item))
441 single_menu_item (XCAR (item), XCDR (item),
442 &pending_maps, notreal, maxdepth);
443 else if (VECTORP (item))
445 /* Loop over the char values represented in the vector. */
446 int len = XVECTOR (item)->size;
447 int c;
448 for (c = 0; c < len; c++)
450 Lisp_Object character;
451 XSETFASTINT (character, c);
452 single_menu_item (character, XVECTOR (item)->contents[c],
453 &pending_maps, notreal, maxdepth);
456 UNGCPRO;
459 /* Process now any submenus which want to be panes at this level. */
460 while (!NILP (pending_maps))
462 Lisp_Object elt, eltcdr, string;
463 elt = Fcar (pending_maps);
464 eltcdr = XCDR (elt);
465 string = XCAR (eltcdr);
466 /* We no longer discard the @ from the beginning of the string here.
467 Instead, we do this in mac_menu_show. */
468 single_keymap_panes (Fcar (elt), string,
469 XCDR (eltcdr), notreal, maxdepth - 1);
470 pending_maps = Fcdr (pending_maps);
474 /* This is a subroutine of single_keymap_panes that handles one
475 keymap entry.
476 KEY is a key in a keymap and ITEM is its binding.
477 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
478 separate panes.
479 If NOTREAL is nonzero, only check for equivalent key bindings, don't
480 evaluate expressions in menu items and don't make any menu.
481 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
483 static void
484 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
485 Lisp_Object key, item;
486 Lisp_Object *pending_maps_ptr;
487 int maxdepth, notreal;
489 Lisp_Object map, item_string, enabled;
490 struct gcpro gcpro1, gcpro2;
491 int res;
493 /* Parse the menu item and leave the result in item_properties. */
494 GCPRO2 (key, item);
495 res = parse_menu_item (item, notreal, 0);
496 UNGCPRO;
497 if (!res)
498 return; /* Not a menu item. */
500 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
502 if (notreal)
504 /* We don't want to make a menu, just traverse the keymaps to
505 precompute equivalent key bindings. */
506 if (!NILP (map))
507 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
508 return;
511 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
512 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
514 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
516 if (!NILP (enabled))
517 /* An enabled separate pane. Remember this to handle it later. */
518 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
519 *pending_maps_ptr);
520 return;
523 push_menu_item (item_string, enabled, key,
524 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
525 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
526 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
527 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
528 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
530 /* Display a submenu using the toolkit. */
531 if (! (NILP (map) || NILP (enabled)))
533 push_submenu_start ();
534 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
535 push_submenu_end ();
539 /* Push all the panes and items of a menu described by the
540 alist-of-alists MENU.
541 This handles old-fashioned calls to x-popup-menu. */
543 static void
544 list_of_panes (menu)
545 Lisp_Object menu;
547 Lisp_Object tail;
549 init_menu_items ();
551 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
553 Lisp_Object elt, pane_name, pane_data;
554 elt = Fcar (tail);
555 pane_name = Fcar (elt);
556 CHECK_STRING (pane_name, 0);
557 push_menu_pane (pane_name, Qnil);
558 pane_data = Fcdr (elt);
559 CHECK_CONS (pane_data, 0);
560 list_of_items (pane_data);
563 finish_menu_items ();
566 /* Push the items in a single pane defined by the alist PANE. */
568 static void
569 list_of_items (pane)
570 Lisp_Object pane;
572 Lisp_Object tail, item, item1;
574 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
576 item = Fcar (tail);
577 if (STRINGP (item))
578 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
579 else if (NILP (item))
580 push_left_right_boundary ();
581 else
583 CHECK_CONS (item, 0);
584 item1 = Fcar (item);
585 CHECK_STRING (item1, 1);
586 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
591 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
592 "Pop up a deck-of-cards menu and return user's selection.\n\
593 POSITION is a position specification. This is either a mouse button event\n\
594 or a list ((XOFFSET YOFFSET) WINDOW)\n\
595 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
596 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
597 This controls the position of the center of the first line\n\
598 in the first pane of the menu, not the top left of the menu as a whole.\n\
599 If POSITION is t, it means to use the current mouse position.\n\
601 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
602 The menu items come from key bindings that have a menu string as well as\n\
603 a definition; actually, the \"definition\" in such a key binding looks like\n\
604 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
605 the keymap as a top-level element.\n\n\
606 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
607 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
609 You can also use a list of keymaps as MENU.\n\
610 Then each keymap makes a separate pane.\n\
611 When MENU is a keymap or a list of keymaps, the return value\n\
612 is a list of events.\n\n\
614 Alternatively, you can specify a menu of multiple panes\n\
615 with a list of the form (TITLE PANE1 PANE2...),\n\
616 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
617 Each ITEM is normally a cons cell (STRING . VALUE);\n\
618 but a string can appear as an item--that makes a nonselectable line\n\
619 in the menu.\n\
620 With this form of menu, the return value is VALUE from the chosen item.\n\
622 If POSITION is nil, don't display the menu at all, just precalculate the\n\
623 cached information about equivalent key sequences.")
624 (position, menu)
625 Lisp_Object position, menu;
627 Lisp_Object keymap, tem;
628 int xpos, ypos;
629 Lisp_Object title;
630 char *error_name;
631 Lisp_Object selection;
632 FRAME_PTR f;
633 Lisp_Object x, y, window;
634 int keymaps = 0;
635 int for_click = 0;
636 struct gcpro gcpro1;
638 #ifdef HAVE_MENUS
639 if (! NILP (position))
641 check_mac ();
643 /* Decode the first argument: find the window and the coordinates. */
644 if (EQ (position, Qt)
645 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
647 /* Use the mouse's current position. */
648 FRAME_PTR new_f = SELECTED_FRAME ();
649 Lisp_Object bar_window;
650 enum scroll_bar_part part;
651 unsigned long time;
653 if (mouse_position_hook)
654 (*mouse_position_hook) (&new_f, 1, &bar_window,
655 &part, &x, &y, &time);
656 if (new_f != 0)
657 XSETFRAME (window, new_f);
658 else
660 window = selected_window;
661 XSETFASTINT (x, 0);
662 XSETFASTINT (y, 0);
665 else
667 tem = Fcar (position);
668 if (CONSP (tem))
670 window = Fcar (Fcdr (position));
671 x = Fcar (tem);
672 y = Fcar (Fcdr (tem));
674 else
676 for_click = 1;
677 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
678 window = Fcar (tem); /* POSN_WINDOW (tem) */
679 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
680 x = Fcar (tem);
681 y = Fcdr (tem);
685 CHECK_NUMBER (x, 0);
686 CHECK_NUMBER (y, 0);
688 /* Decode where to put the menu. */
690 if (FRAMEP (window))
692 f = XFRAME (window);
693 xpos = 0;
694 ypos = 0;
696 else if (WINDOWP (window))
698 CHECK_LIVE_WINDOW (window, 0);
699 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
701 xpos = (FONT_WIDTH (FRAME_FONT (f))
702 * XFASTINT (XWINDOW (window)->left));
703 ypos = (FRAME_LINE_HEIGHT (f)
704 * XFASTINT (XWINDOW (window)->top));
706 else
707 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
708 but I don't want to make one now. */
709 CHECK_WINDOW (window, 0);
711 xpos += XINT (x);
712 ypos += XINT (y);
714 XSETFRAME (Vmenu_updating_frame, f);
716 Vmenu_updating_frame = Qnil;
717 #endif /* HAVE_MENUS */
719 title = Qnil;
720 GCPRO1 (title);
722 /* Decode the menu items from what was specified. */
724 keymap = Fkeymapp (menu);
725 tem = Qnil;
726 if (CONSP (menu))
727 tem = Fkeymapp (Fcar (menu));
728 if (!NILP (keymap))
730 /* We were given a keymap. Extract menu info from the keymap. */
731 Lisp_Object prompt;
732 keymap = get_keymap (menu);
734 /* Extract the detailed info to make one pane. */
735 keymap_panes (&menu, 1, NILP (position));
737 /* Search for a string appearing directly as an element of the keymap.
738 That string is the title of the menu. */
739 prompt = Fkeymap_prompt (keymap);
740 if (NILP (title) && !NILP (prompt))
741 title = prompt;
743 /* Make that be the pane title of the first pane. */
744 if (!NILP (prompt) && menu_items_n_panes >= 0)
745 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
747 keymaps = 1;
749 else if (!NILP (tem))
751 /* We were given a list of keymaps. */
752 int nmaps = XFASTINT (Flength (menu));
753 Lisp_Object *maps
754 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
755 int i;
757 title = Qnil;
759 /* The first keymap that has a prompt string
760 supplies the menu title. */
761 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
763 Lisp_Object prompt;
765 maps[i++] = keymap = get_keymap (Fcar (tem));
767 prompt = Fkeymap_prompt (keymap);
768 if (NILP (title) && !NILP (prompt))
769 title = prompt;
772 /* Extract the detailed info to make one pane. */
773 keymap_panes (maps, nmaps, NILP (position));
775 /* Make the title be the pane title of the first pane. */
776 if (!NILP (title) && menu_items_n_panes >= 0)
777 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
779 keymaps = 1;
781 else
783 /* We were given an old-fashioned menu. */
784 title = Fcar (menu);
785 CHECK_STRING (title, 1);
787 list_of_panes (Fcdr (menu));
789 keymaps = 0;
792 if (NILP (position))
794 discard_menu_items ();
795 UNGCPRO;
796 return Qnil;
799 #ifdef HAVE_MENUS
800 /* Display them in a menu. */
801 BLOCK_INPUT;
803 selection = mac_menu_show (f, xpos, ypos, for_click,
804 keymaps, title, &error_name);
805 UNBLOCK_INPUT;
807 discard_menu_items ();
809 UNGCPRO;
810 #endif /* HAVE_MENUS */
812 if (error_name) error (error_name);
813 return selection;
816 #ifdef HAVE_MENUS
818 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
819 "Pop up a dialog box and return user's selection.\n\
820 POSITION specifies which frame to use.\n\
821 This is normally a mouse button event or a window or frame.\n\
822 If POSITION is t, it means to use the frame the mouse is on.\n\
823 The dialog box appears in the middle of the specified frame.\n\
825 CONTENTS specifies the alternatives to display in the dialog box.\n\
826 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
827 Each ITEM is a cons cell (STRING . VALUE).\n\
828 The return value is VALUE from the chosen item.\n\n\
829 An ITEM may also be just a string--that makes a nonselectable item.\n\
830 An ITEM may also be nil--that means to put all preceding items\n\
831 on the left of the dialog box and all following items on the right.\n\
832 \(By default, approximately half appear on each side.)")
833 (position, contents)
834 Lisp_Object position, contents;
836 FRAME_PTR f;
837 Lisp_Object window;
839 check_mac ();
841 /* Decode the first argument: find the window or frame to use. */
842 if (EQ (position, Qt)
843 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
845 #if 0 /* Using the frame the mouse is on may not be right. */
846 /* Use the mouse's current position. */
847 FRAME_PTR new_f = SELECTED_FRAME ();
848 Lisp_Object bar_window;
849 int part;
850 unsigned long time;
851 Lisp_Object x, y;
853 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
855 if (new_f != 0)
856 XSETFRAME (window, new_f);
857 else
858 window = selected_window;
859 #endif
860 window = selected_window;
862 else if (CONSP (position))
864 Lisp_Object tem;
865 tem = Fcar (position);
866 if (CONSP (tem))
867 window = Fcar (Fcdr (position));
868 else
870 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
871 window = Fcar (tem); /* POSN_WINDOW (tem) */
874 else if (WINDOWP (position) || FRAMEP (position))
875 window = position;
876 else
877 window = Qnil;
879 /* Decode where to put the menu. */
881 if (FRAMEP (window))
882 f = XFRAME (window);
883 else if (WINDOWP (window))
885 CHECK_LIVE_WINDOW (window, 0);
886 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
888 else
889 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
890 but I don't want to make one now. */
891 CHECK_WINDOW (window, 0);
893 #ifndef HAVE_DIALOGS
894 /* Display a menu with these alternatives
895 in the middle of frame F. */
897 Lisp_Object x, y, frame, newpos;
898 XSETFRAME (frame, f);
899 XSETINT (x, x_pixel_width (f) / 2);
900 XSETINT (y, x_pixel_height (f) / 2);
901 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
903 return Fx_popup_menu (newpos,
904 Fcons (Fcar (contents), Fcons (contents, Qnil)));
906 #else /* HAVE_DIALOGS */
908 Lisp_Object title;
909 char *error_name;
910 Lisp_Object selection;
912 /* Decode the dialog items from what was specified. */
913 title = Fcar (contents);
914 CHECK_STRING (title, 1);
916 list_of_panes (Fcons (contents, Qnil));
918 /* Display them in a dialog box. */
919 BLOCK_INPUT;
920 selection = mac_dialog_show (f, 0, title, &error_name);
921 UNBLOCK_INPUT;
923 discard_menu_items ();
925 if (error_name) error (error_name);
926 return selection;
928 #endif /* HAVE_DIALOGS */
931 /* Activate the menu bar of frame F.
932 This is called from keyboard.c when it gets the
933 menu_bar_activate_event out of the Emacs event queue.
935 To activate the menu bar, we signal to the input thread that it can
936 return from the WM_INITMENU message, allowing the normal Windows
937 processing of the menus.
939 But first we recompute the menu bar contents (the whole tree).
941 This way we can safely execute Lisp code. */
943 void
944 x_activate_menubar (f)
945 FRAME_PTR f;
947 SInt32 menu_choice;
948 extern Point saved_menu_event_location;
950 set_frame_menubar (f, 0, 1);
951 BLOCK_INPUT;
953 menu_choice = MenuSelect (saved_menu_event_location);
954 do_menu_choice (menu_choice);
956 UNBLOCK_INPUT;
959 /* This callback is called from the menu bar pulldown menu
960 when the user makes a selection.
961 Figure out what the user chose
962 and put the appropriate events into the keyboard buffer. */
964 void
965 menubar_selection_callback (FRAME_PTR f, int client_data)
967 Lisp_Object prefix, entry;
968 Lisp_Object vector;
969 Lisp_Object *subprefix_stack;
970 int submenu_depth = 0;
971 int i;
973 if (!f)
974 return;
975 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
976 vector = f->menu_bar_vector;
977 prefix = Qnil;
978 i = 0;
979 while (i < f->menu_bar_items_used)
981 if (EQ (XVECTOR (vector)->contents[i], Qnil))
983 subprefix_stack[submenu_depth++] = prefix;
984 prefix = entry;
985 i++;
987 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
989 prefix = subprefix_stack[--submenu_depth];
990 i++;
992 else if (EQ (XVECTOR (vector)->contents[i], Qt))
994 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
995 i += MENU_ITEMS_PANE_LENGTH;
997 else
999 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1000 if (client_data == i)
1002 int j;
1003 struct input_event buf;
1004 Lisp_Object frame;
1006 XSETFRAME (frame, f);
1007 buf.kind = MENU_BAR_EVENT;
1008 buf.frame_or_window = frame;
1009 buf.arg = frame;
1010 kbd_buffer_store_event (&buf);
1012 for (j = 0; j < submenu_depth; j++)
1013 if (!NILP (subprefix_stack[j]))
1015 buf.kind = MENU_BAR_EVENT;
1016 buf.frame_or_window = frame;
1017 buf.arg = subprefix_stack[j];
1018 kbd_buffer_store_event (&buf);
1021 if (!NILP (prefix))
1023 buf.kind = MENU_BAR_EVENT;
1024 buf.frame_or_window = frame;
1025 buf.arg = prefix;
1026 kbd_buffer_store_event (&buf);
1029 buf.kind = MENU_BAR_EVENT;
1030 buf.frame_or_window = frame;
1031 buf.arg = entry;
1032 kbd_buffer_store_event (&buf);
1034 #if 0
1035 /* Queue this to recompute possibly updated menubar. */
1036 buf.kind = menu_bar_activate_event;
1037 buf.frame_or_window = frame;
1038 buf.arg = Qnil;
1039 kbd_buffer_store_event (&buf);
1040 #endif
1042 return;
1044 i += MENU_ITEMS_ITEM_LENGTH;
1049 /* Allocate a widget_value, blocking input. */
1051 widget_value *
1052 xmalloc_widget_value ()
1054 widget_value *value;
1056 BLOCK_INPUT;
1057 value = malloc_widget_value ();
1058 UNBLOCK_INPUT;
1060 return value;
1063 /* This recursively calls free_widget_value on the tree of widgets.
1064 It must free all data that was malloc'ed for these widget_values.
1065 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1066 must be left alone. */
1068 void
1069 free_menubar_widget_value_tree (wv)
1070 widget_value *wv;
1072 if (! wv) return;
1074 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1076 if (wv->contents && (wv->contents != (widget_value*)1))
1078 free_menubar_widget_value_tree (wv->contents);
1079 wv->contents = (widget_value *) 0xDEADBEEF;
1081 if (wv->next)
1083 free_menubar_widget_value_tree (wv->next);
1084 wv->next = (widget_value *) 0xDEADBEEF;
1086 BLOCK_INPUT;
1087 free_widget_value (wv);
1088 UNBLOCK_INPUT;
1091 /* Return a tree of widget_value structures for a menu bar item
1092 whose event type is ITEM_KEY (with string ITEM_NAME)
1093 and whose contents come from the list of keymaps MAPS. */
1095 static widget_value *
1096 single_submenu (item_key, item_name, maps)
1097 Lisp_Object item_key, item_name, maps;
1099 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1100 int i;
1101 int submenu_depth = 0;
1102 Lisp_Object length;
1103 int len;
1104 Lisp_Object *mapvec;
1105 widget_value **submenu_stack;
1106 int previous_items = menu_items_used;
1107 int top_level_items = 0;
1109 length = Flength (maps);
1110 len = XINT (length);
1112 /* Convert the list MAPS into a vector MAPVEC. */
1113 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1114 for (i = 0; i < len; i++)
1116 mapvec[i] = Fcar (maps);
1117 maps = Fcdr (maps);
1120 menu_items_n_panes = 0;
1122 /* Loop over the given keymaps, making a pane for each map.
1123 But don't make a pane that is empty--ignore that map instead. */
1124 for (i = 0; i < len; i++)
1126 if (SYMBOLP (mapvec[i])
1127 || (CONSP (mapvec[i])
1128 && NILP (Fkeymapp (mapvec[i]))))
1130 /* Here we have a command at top level in the menu bar
1131 as opposed to a submenu. */
1132 top_level_items = 1;
1133 push_menu_pane (Qnil, Qnil);
1134 push_menu_item (item_name, Qt, item_key, mapvec[i],
1135 Qnil, Qnil, Qnil, Qnil);
1137 else
1138 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1141 /* Create a tree of widget_value objects
1142 representing the panes and their items. */
1144 submenu_stack
1145 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1146 wv = xmalloc_widget_value ();
1147 wv->name = "menu";
1148 wv->value = 0;
1149 wv->enabled = 1;
1150 wv->button_type = BUTTON_TYPE_NONE;
1151 first_wv = wv;
1152 save_wv = 0;
1153 prev_wv = 0;
1155 /* Loop over all panes and items made during this call
1156 and construct a tree of widget_value objects.
1157 Ignore the panes and items made by previous calls to
1158 single_submenu, even though those are also in menu_items. */
1159 i = previous_items;
1160 while (i < menu_items_used)
1162 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1164 submenu_stack[submenu_depth++] = save_wv;
1165 save_wv = prev_wv;
1166 prev_wv = 0;
1167 i++;
1169 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1171 prev_wv = save_wv;
1172 save_wv = submenu_stack[--submenu_depth];
1173 i++;
1175 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1176 && submenu_depth != 0)
1177 i += MENU_ITEMS_PANE_LENGTH;
1178 /* Ignore a nil in the item list.
1179 It's meaningful only for dialog boxes. */
1180 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1181 i += 1;
1182 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1184 /* Create a new pane. */
1185 Lisp_Object pane_name, prefix;
1186 char *pane_string;
1187 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1188 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1189 #ifndef HAVE_MULTILINGUAL_MENU
1190 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1191 pane_name = string_make_unibyte (pane_name);
1192 #endif
1193 pane_string = (NILP (pane_name)
1194 ? "" : (char *) XSTRING (pane_name)->data);
1195 /* If there is just one top-level pane, put all its items directly
1196 under the top-level menu. */
1197 if (menu_items_n_panes == 1)
1198 pane_string = "";
1200 /* If the pane has a meaningful name,
1201 make the pane a top-level menu item
1202 with its items as a submenu beneath it. */
1203 if (strcmp (pane_string, ""))
1205 wv = xmalloc_widget_value ();
1206 if (save_wv)
1207 save_wv->next = wv;
1208 else
1209 first_wv->contents = wv;
1210 wv->name = pane_string;
1211 /* Ignore the @ that means "separate pane".
1212 This is a kludge, but this isn't worth more time. */
1213 if (!NILP (prefix) && wv->name[0] == '@')
1214 wv->name++;
1215 wv->value = 0;
1216 wv->enabled = 1;
1217 wv->button_type = BUTTON_TYPE_NONE;
1219 save_wv = wv;
1220 prev_wv = 0;
1221 i += MENU_ITEMS_PANE_LENGTH;
1223 else
1225 /* Create a new item within current pane. */
1226 Lisp_Object item_name, enable, descrip, def, type, selected;
1227 Lisp_Object help;
1229 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1230 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1231 descrip
1232 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1233 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1234 type = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_TYPE];
1235 selected = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_SELECTED];
1236 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1238 #ifndef HAVE_MULTILINGUAL_MENU
1239 if (STRING_MULTIBYTE (item_name))
1240 item_name = string_make_unibyte (item_name);
1241 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1242 descrip = string_make_unibyte (descrip);
1243 #endif
1245 wv = xmalloc_widget_value ();
1246 if (prev_wv)
1247 prev_wv->next = wv;
1248 else
1249 save_wv->contents = wv;
1251 wv->name = (char *) XSTRING (item_name)->data;
1252 if (!NILP (descrip))
1253 wv->key = (char *) XSTRING (descrip)->data;
1254 wv->value = 0;
1255 /* The EMACS_INT cast avoids a warning. There's no problem
1256 as long as pointers have enough bits to hold small integers. */
1257 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1258 wv->enabled = !NILP (enable);
1260 if (NILP (type))
1261 wv->button_type = BUTTON_TYPE_NONE;
1262 else if (EQ (type, QCradio))
1263 wv->button_type = BUTTON_TYPE_RADIO;
1264 else if (EQ (type, QCtoggle))
1265 wv->button_type = BUTTON_TYPE_TOGGLE;
1266 else
1267 abort ();
1269 wv->selected = !NILP (selected);
1270 if (STRINGP (help))
1271 wv->help = (char *) XSTRING (help)->data;
1272 else
1273 wv->help = NULL;
1275 prev_wv = wv;
1277 i += MENU_ITEMS_ITEM_LENGTH;
1281 /* If we have just one "menu item"
1282 that was originally a button, return it by itself. */
1283 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1285 wv = first_wv->contents;
1286 free_widget_value (first_wv);
1287 return wv;
1290 return first_wv;
1293 /* Set the contents of the menubar widgets of frame F.
1294 The argument FIRST_TIME is currently ignored;
1295 it is set the first time this is called, from initialize_frame_menubar. */
1297 void
1298 set_frame_menubar (f, first_time, deep_p)
1299 FRAME_PTR f;
1300 int first_time;
1301 int deep_p;
1303 int menubar_widget = f->output_data.mac->menubar_widget;
1304 Lisp_Object items;
1305 widget_value *wv, *first_wv, *prev_wv = 0;
1306 int i;
1308 XSETFRAME (Vmenu_updating_frame, f);
1310 wv = xmalloc_widget_value ();
1311 wv->name = "menubar";
1312 wv->value = 0;
1313 wv->enabled = 1;
1314 wv->button_type = BUTTON_TYPE_NONE;
1315 first_wv = wv;
1318 /* Make a widget-value tree representing the entire menu trees. */
1320 struct buffer *prev = current_buffer;
1321 Lisp_Object buffer;
1322 int specpdl_count = specpdl_ptr - specpdl;
1323 int previous_menu_items_used = f->menu_bar_items_used;
1324 Lisp_Object *previous_items
1325 = (Lisp_Object *) alloca (previous_menu_items_used
1326 * sizeof (Lisp_Object));
1328 /* If we are making a new widget, its contents are empty,
1329 do always reinitialize them. */
1330 if (! menubar_widget)
1331 previous_menu_items_used = 0;
1333 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1334 specbind (Qinhibit_quit, Qt);
1335 /* Don't let the debugger step into this code
1336 because it is not reentrant. */
1337 specbind (Qdebug_on_next_call, Qnil);
1339 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1340 if (NILP (Voverriding_local_map_menu_flag))
1342 specbind (Qoverriding_terminal_local_map, Qnil);
1343 specbind (Qoverriding_local_map, Qnil);
1346 set_buffer_internal_1 (XBUFFER (buffer));
1348 /* Run the Lucid hook. */
1349 safe_run_hooks (Qactivate_menubar_hook);
1350 /* If it has changed current-menubar from previous value,
1351 really recompute the menubar from the value. */
1352 if (! NILP (Vlucid_menu_bar_dirty_flag))
1353 call0 (Qrecompute_lucid_menubar);
1354 safe_run_hooks (Qmenu_bar_update_hook);
1355 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1357 items = FRAME_MENU_BAR_ITEMS (f);
1359 inhibit_garbage_collection ();
1361 /* Save the frame's previous menu bar contents data. */
1362 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1363 previous_menu_items_used * sizeof (Lisp_Object));
1365 /* Fill in the current menu bar contents. */
1366 menu_items = f->menu_bar_vector;
1367 menu_items_allocated = XVECTOR (menu_items)->size;
1368 init_menu_items ();
1369 for (i = 0; i < XVECTOR (items)->size; i += 4)
1371 Lisp_Object key, string, maps;
1373 key = XVECTOR (items)->contents[i];
1374 string = XVECTOR (items)->contents[i + 1];
1375 maps = XVECTOR (items)->contents[i + 2];
1376 if (NILP (string))
1377 break;
1379 wv = single_submenu (key, string, maps);
1380 if (prev_wv)
1381 prev_wv->next = wv;
1382 else
1383 first_wv->contents = wv;
1384 /* Don't set wv->name here; GC during the loop might relocate it. */
1385 wv->enabled = 1;
1386 wv->button_type = BUTTON_TYPE_NONE;
1387 prev_wv = wv;
1390 finish_menu_items ();
1392 set_buffer_internal_1 (prev);
1393 unbind_to (specpdl_count, Qnil);
1395 /* If there has been no change in the Lisp-level contents
1396 of the menu bar, skip redisplaying it. Just exit. */
1398 for (i = 0; i < previous_menu_items_used; i++)
1399 if (menu_items_used == i
1400 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1401 break;
1402 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1404 free_menubar_widget_value_tree (first_wv);
1405 menu_items = Qnil;
1407 return;
1410 /* Now GC cannot happen during the lifetime of the widget_value,
1411 so it's safe to store data from a Lisp_String. */
1412 wv = first_wv->contents;
1413 for (i = 0; i < XVECTOR (items)->size; i += 4)
1415 Lisp_Object string;
1416 string = XVECTOR (items)->contents[i + 1];
1417 if (NILP (string))
1418 break;
1419 wv->name = (char *) XSTRING (string)->data;
1420 wv = wv->next;
1423 f->menu_bar_vector = menu_items;
1424 f->menu_bar_items_used = menu_items_used;
1425 menu_items = Qnil;
1428 /* Create or update the menu bar widget. */
1430 BLOCK_INPUT;
1432 f->output_data.mac->menubar_widget = NULL; /* always NULL on Mac */
1435 int i = MIN_MENU_ID;
1436 MenuHandle menu = GetMenuHandle (i);
1437 while (menu != NULL)
1439 DeleteMenu (i);
1440 DisposeMenu (menu);
1441 menu = GetMenuHandle (++i);
1444 i = MIN_SUBMENU_ID;
1445 menu = GetMenuHandle (i);
1446 while (menu != NULL)
1448 DeleteMenu (i);
1449 DisposeMenu (menu);
1450 menu = GetMenuHandle (++i);
1454 fill_menubar (first_wv->contents);
1456 DrawMenuBar ();
1458 free_menubar_widget_value_tree (first_wv);
1460 UNBLOCK_INPUT;
1463 /* Called from Fx_create_frame to create the initial menubar of a
1464 frame before it is mapped, so that the window is mapped with the
1465 menubar already there instead of us tacking it on later and
1466 thrashing the window after it is visible. */
1468 void
1469 initialize_frame_menubar (f)
1470 FRAME_PTR f;
1472 /* This function is called before the first chance to redisplay
1473 the frame. It has to be, so the frame will have the right size. */
1474 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1475 set_frame_menubar (f, 1, 1);
1478 /* Get rid of the menu bar of frame F, and free its storage.
1479 This is used when deleting a frame, and when turning off the menu bar. */
1481 void
1482 free_frame_menubar (f)
1483 FRAME_PTR f;
1485 /* Nothing to do since set_frame_menubar disposes of menus before
1486 installing new ones. */
1490 /* mac_menu_show actually displays a menu using the panes and items in
1491 menu_items and returns the value selected from it; we assume input
1492 is blocked by the caller. */
1494 /* F is the frame the menu is for.
1495 X and Y are the frame-relative specified position,
1496 relative to the inside upper left corner of the frame F.
1497 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1498 KEYMAPS is 1 if this menu was specified with keymaps;
1499 in that case, we return a list containing the chosen item's value
1500 and perhaps also the pane's prefix.
1501 TITLE is the specified menu title.
1502 ERROR is a place to store an error message string in case of failure.
1503 (We return nil on failure, but the value doesn't actually matter.) */
1505 static Lisp_Object
1506 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1507 FRAME_PTR f;
1508 int x;
1509 int y;
1510 int for_click;
1511 int keymaps;
1512 Lisp_Object title;
1513 char **error;
1515 int i;
1516 int menu_item_selection;
1517 MenuHandle menu;
1518 Point pos;
1519 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1520 widget_value **submenu_stack
1521 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1522 Lisp_Object *subprefix_stack
1523 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1524 int submenu_depth = 0;
1525 int first_pane;
1526 int next_release_must_exit = 0;
1528 *error = NULL;
1530 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1532 *error = "Empty menu";
1533 return Qnil;
1536 /* Create a tree of widget_value objects
1537 representing the panes and their items. */
1538 wv = xmalloc_widget_value ();
1539 wv->name = "menu";
1540 wv->value = 0;
1541 wv->enabled = 1;
1542 wv->button_type = BUTTON_TYPE_NONE;
1543 first_wv = wv;
1544 first_pane = 1;
1546 /* Loop over all panes and items, filling in the tree. */
1547 i = 0;
1548 while (i < menu_items_used)
1550 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1552 submenu_stack[submenu_depth++] = save_wv;
1553 save_wv = prev_wv;
1554 prev_wv = 0;
1555 first_pane = 1;
1556 i++;
1558 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1560 prev_wv = save_wv;
1561 save_wv = submenu_stack[--submenu_depth];
1562 first_pane = 0;
1563 i++;
1565 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1566 && submenu_depth != 0)
1567 i += MENU_ITEMS_PANE_LENGTH;
1568 /* Ignore a nil in the item list.
1569 It's meaningful only for dialog boxes. */
1570 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1571 i += 1;
1572 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1574 /* Create a new pane. */
1575 Lisp_Object pane_name, prefix;
1576 char *pane_string;
1577 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1578 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1579 #ifndef HAVE_MULTILINGUAL_MENU
1580 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1581 pane_name = string_make_unibyte (pane_name);
1582 #endif
1583 pane_string = (NILP (pane_name)
1584 ? "" : (char *) XSTRING (pane_name)->data);
1585 /* If there is just one top-level pane, put all its items directly
1586 under the top-level menu. */
1587 if (menu_items_n_panes == 1)
1588 pane_string = "";
1590 /* If the pane has a meaningful name,
1591 make the pane a top-level menu item
1592 with its items as a submenu beneath it. */
1593 if (!keymaps && strcmp (pane_string, ""))
1595 wv = xmalloc_widget_value ();
1596 if (save_wv)
1597 save_wv->next = wv;
1598 else
1599 first_wv->contents = wv;
1600 wv->name = pane_string;
1601 if (keymaps && !NILP (prefix))
1602 wv->name++;
1603 wv->value = 0;
1604 wv->enabled = 1;
1605 wv->button_type = BUTTON_TYPE_NONE;
1606 save_wv = wv;
1607 prev_wv = 0;
1609 else if (first_pane)
1611 save_wv = wv;
1612 prev_wv = 0;
1614 first_pane = 0;
1615 i += MENU_ITEMS_PANE_LENGTH;
1617 else
1619 /* Create a new item within current pane. */
1620 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1622 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1623 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1624 descrip
1625 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1626 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1627 type = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_TYPE];
1628 selected = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_SELECTED];
1629 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1631 #ifndef HAVE_MULTILINGUAL_MENU
1632 if (STRING_MULTIBYTE (item_name))
1633 item_name = string_make_unibyte (item_name);
1634 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1635 descrip = string_make_unibyte (descrip);
1636 #endif
1638 wv = xmalloc_widget_value ();
1639 if (prev_wv)
1640 prev_wv->next = wv;
1641 else
1642 save_wv->contents = wv;
1643 wv->name = (char *) XSTRING (item_name)->data;
1644 if (!NILP (descrip))
1645 wv->key = (char *) XSTRING (descrip)->data;
1646 wv->value = 0;
1647 /* Use the contents index as call_data, since we are
1648 restricted to 16-bits.. */
1649 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1650 wv->enabled = !NILP (enable);
1652 if (NILP (type))
1653 wv->button_type = BUTTON_TYPE_NONE;
1654 else if (EQ (type, QCtoggle))
1655 wv->button_type = BUTTON_TYPE_TOGGLE;
1656 else if (EQ (type, QCradio))
1657 wv->button_type = BUTTON_TYPE_RADIO;
1658 else
1659 abort ();
1661 wv->selected = !NILP (selected);
1663 if (STRINGP (help))
1664 wv->help = (char *) XSTRING (help)->data;
1665 else
1666 wv->help = NULL;
1668 prev_wv = wv;
1670 i += MENU_ITEMS_ITEM_LENGTH;
1674 /* Deal with the title, if it is non-nil. */
1675 if (!NILP (title))
1677 widget_value *wv_title = xmalloc_widget_value ();
1678 widget_value *wv_sep = xmalloc_widget_value ();
1680 /* Maybe replace this separator with a bitmap or owner-draw item
1681 so that it looks better. Having two separators looks odd. */
1682 wv_sep->name = "--";
1683 wv_sep->next = first_wv->contents;
1685 #ifndef HAVE_MULTILINGUAL_MENU
1686 if (STRING_MULTIBYTE (title))
1687 title = string_make_unibyte (title);
1688 #endif
1689 wv_title->name = (char *) XSTRING (title)->data;
1690 wv_title->enabled = True;
1691 wv_title->button_type = BUTTON_TYPE_NONE;
1692 wv_title->next = wv_sep;
1693 first_wv->contents = wv_title;
1696 /* Actually create the menu. */
1697 menu = NewMenu (POPUP_SUBMENU_ID, "\p");
1698 fill_submenu (menu, first_wv->contents, 0);
1700 /* Adjust coordinates to be root-window-relative. */
1701 pos.h = x;
1702 pos.v = y;
1703 SetPort (FRAME_MAC_WINDOW (f));
1704 LocalToGlobal (&pos);
1706 InsertMenu (menu, -1);
1708 /* Display the menu. */
1709 menu_item_selection = LoWord (PopUpMenuSelect (menu, pos.v, pos.h, 0));
1711 GetMenuItemRefCon (menu, menu_item_selection, &menu_item_selection);
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