Use macro SPECPDL_INDEX.
[bpt/emacs.git] / src / macmenu.c
CommitLineData
1a578e9b 1/* Menu support for GNU Emacs on the for Mac OS.
e0f712ba 2 Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
1a578e9b
AC
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
20
e0f712ba 21/* Contributed by Andrew Choi (akochoi@mac.com). */
1a578e9b
AC
22
23#include <config.h>
24#include <signal.h>
25
26#include <stdio.h>
27#include "lisp.h"
28#include "termhooks.h"
e0f712ba
AC
29#include "keyboard.h"
30#include "keymap.h"
1a578e9b
AC
31#include "frame.h"
32#include "window.h"
1a578e9b
AC
33#include "blockinput.h"
34#include "buffer.h"
35#include "charset.h"
36#include "coding.h"
37
e0f712ba
AC
38#ifdef MAC_OSX
39#undef mktime
40#undef DEBUG
41#undef Z
42#undef free
43#undef malloc
44#undef realloc
45/* Macros max and min defined in lisp.h conflict with those in
46 precompiled header Carbon.h. */
47#undef max
48#undef min
f00691a3 49#undef init_process
e0f712ba
AC
50#include <Carbon/Carbon.h>
51#undef Z
52#define Z (current_buffer->text->z)
53#undef free
54#define free unexec_free
55#undef malloc
56#define malloc unexec_malloc
57#undef realloc
58#define realloc unexec_realloc
59#undef min
60#define min(a, b) ((a) < (b) ? (a) : (b))
61#undef max
62#define max(a, b) ((a) > (b) ? (a) : (b))
f00691a3
AC
63#undef init_process
64#define init_process emacs_init_process
e0f712ba 65#else /* not MAC_OSX */
1a578e9b
AC
66#include <MacTypes.h>
67#include <Menus.h>
68#include <QuickDraw.h>
69#include <ToolUtils.h>
70#include <Fonts.h>
71#include <Controls.h>
72#include <Windows.h>
73#include <Events.h>
e0f712ba 74#if defined (__MRC__) || (__MSL__ >= 0x6000)
1a578e9b
AC
75#include <ControlDefinitions.h>
76#endif
e0f712ba 77#endif /* not MAC_OSX */
1a578e9b
AC
78
79/* This may include sys/types.h, and that somehow loses
80 if this is not done before the other system files. */
81#include "macterm.h"
82
83/* Load sys/types.h if not already loaded.
84 In some systems loading it twice is suicidal. */
85#ifndef makedev
86#include <sys/types.h>
87#endif
88
89#include "dispextern.h"
90
91#define POPUP_SUBMENU_ID 235
92#define MIN_MENU_ID 256
93#define MIN_SUBMENU_ID 1
94
95#define DIALOG_WINDOW_RESOURCE 130
96
97#define HAVE_DIALOGS 1
98
99#undef HAVE_MULTILINGUAL_MENU
e0f712ba 100#undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
1a578e9b
AC
101
102/******************************************************************/
103/* Definitions copied from lwlib.h */
104
105typedef void * XtPointer;
106
1a578e9b
AC
107enum button_type
108{
109 BUTTON_TYPE_NONE,
110 BUTTON_TYPE_TOGGLE,
111 BUTTON_TYPE_RADIO
112};
113
e0f712ba
AC
114/* This structure is based on the one in ../lwlib/lwlib.h, modified
115 for Mac OS. */
1a578e9b
AC
116typedef struct _widget_value
117{
118 /* name of widget */
119 char* name;
120 /* value (meaning depend on widget type) */
121 char* value;
122 /* keyboard equivalent. no implications for XtTranslations */
123 char* key;
e0f712ba
AC
124 /* Help string or nil if none.
125 GC finds this string through the frame's menu_bar_vector
126 or through menu_items. */
127 Lisp_Object help;
1a578e9b
AC
128 /* true if enabled */
129 Boolean enabled;
130 /* true if selected */
131 Boolean selected;
132 /* The type of a button. */
133 enum button_type button_type;
134 /* true if menu title */
135 Boolean title;
136#if 0
137 /* true if was edited (maintained by get_value) */
138 Boolean edited;
139 /* true if has changed (maintained by lw library) */
140 change_type change;
141 /* true if this widget itself has changed,
142 but not counting the other widgets found in the `next' field. */
143 change_type this_one_change;
144#endif
145 /* Contents of the sub-widgets, also selected slot for checkbox */
146 struct _widget_value* contents;
147 /* data passed to callback */
148 XtPointer call_data;
149 /* next one in the list */
150 struct _widget_value* next;
151#if 0
152 /* slot for the toolkit dependent part. Always initialize to NULL. */
153 void* toolkit_data;
154 /* tell us if we should free the toolkit data slot when freeing the
155 widget_value itself. */
156 Boolean free_toolkit_data;
157
158 /* we resource the widget_value structures; this points to the next
159 one on the free list if this one has been deallocated.
160 */
161 struct _widget_value *free_list;
162#endif
163} widget_value;
164
165/* Assumed by other routines to zero area returned. */
166#define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
167 0, (sizeof (widget_value)))
168#define free_widget_value(wv) xfree (wv)
169
170/******************************************************************/
171
1a578e9b
AC
172#ifndef TRUE
173#define TRUE 1
174#define FALSE 0
175#endif /* no TRUE */
176
177Lisp_Object Vmenu_updating_frame;
178
179Lisp_Object Qdebug_on_next_call;
180
181extern Lisp_Object Qmenu_bar;
1a578e9b
AC
182
183extern Lisp_Object QCtoggle, QCradio;
184
185extern Lisp_Object Voverriding_local_map;
186extern Lisp_Object Voverriding_local_map_menu_flag;
187
188extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
189
190extern Lisp_Object Qmenu_bar_update_hook;
191
192void set_frame_menubar ();
193
194static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
195 Lisp_Object, Lisp_Object, Lisp_Object,
196 Lisp_Object, Lisp_Object));
e0f712ba 197#ifdef HAVE_DIALOGS
1a578e9b 198static Lisp_Object mac_dialog_show ();
e0f712ba 199#endif
1a578e9b
AC
200static Lisp_Object mac_menu_show ();
201
202static void keymap_panes ();
203static void single_keymap_panes ();
204static void single_menu_item ();
205static void list_of_panes ();
206static void list_of_items ();
207
208static void fill_submenu (MenuHandle, widget_value *, int);
209static void fill_menubar (widget_value *);
210
211\f
212/* This holds a Lisp vector that holds the results of decoding
213 the keymaps or alist-of-alists that specify a menu.
214
215 It describes the panes and items within the panes.
216
217 Each pane is described by 3 elements in the vector:
218 t, the pane name, the pane's prefix key.
219 Then follow the pane's items, with 5 elements per item:
220 the item string, the enable flag, the item's value,
221 the definition, and the equivalent keyboard key's description string.
222
223 In some cases, multiple levels of menus may be described.
224 A single vector slot containing nil indicates the start of a submenu.
225 A single vector slot containing lambda indicates the end of a submenu.
226 The submenu follows a menu item which is the way to reach the submenu.
227
228 A single vector slot containing quote indicates that the
229 following items should appear on the right of a dialog box.
230
231 Using a Lisp vector to hold this information while we decode it
232 takes care of protecting all the data from GC. */
233
234#define MENU_ITEMS_PANE_NAME 1
235#define MENU_ITEMS_PANE_PREFIX 2
236#define MENU_ITEMS_PANE_LENGTH 3
237
238enum menu_item_idx
239{
240 MENU_ITEMS_ITEM_NAME = 0,
241 MENU_ITEMS_ITEM_ENABLE,
242 MENU_ITEMS_ITEM_VALUE,
243 MENU_ITEMS_ITEM_EQUIV_KEY,
244 MENU_ITEMS_ITEM_DEFINITION,
245 MENU_ITEMS_ITEM_TYPE,
246 MENU_ITEMS_ITEM_SELECTED,
247 MENU_ITEMS_ITEM_HELP,
248 MENU_ITEMS_ITEM_LENGTH
249};
250
251static Lisp_Object menu_items;
252
253/* Number of slots currently allocated in menu_items. */
254static int menu_items_allocated;
255
256/* This is the index in menu_items of the first empty slot. */
257static int menu_items_used;
258
259/* The number of panes currently recorded in menu_items,
260 excluding those within submenus. */
261static int menu_items_n_panes;
262
263/* Current depth within submenus. */
264static int menu_items_submenu_depth;
265
266/* Flag which when set indicates a dialog or menu has been posted by
267 Xt on behalf of one of the widget sets. */
268static int popup_activated_flag;
269
270static int next_menubar_widget_id;
271
272/* This is set nonzero after the user activates the menu bar, and set
273 to zero again after the menu bars are redisplayed by prepare_menu_bar.
274 While it is nonzero, all calls to set_frame_menubar go deep.
275
276 I don't understand why this is needed, but it does seem to be
277 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
278
279int pending_menu_activation;
280\f
281/* Initialize the menu_items structure if we haven't already done so.
282 Also mark it as currently empty. */
283
284static void
285init_menu_items ()
286{
287 if (NILP (menu_items))
288 {
289 menu_items_allocated = 60;
290 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
291 }
292
293 menu_items_used = 0;
294 menu_items_n_panes = 0;
295 menu_items_submenu_depth = 0;
296}
297
298/* Call at the end of generating the data in menu_items.
299 This fills in the number of items in the last pane. */
300
301static void
302finish_menu_items ()
303{
304}
305
306/* Call when finished using the data for the current menu
307 in menu_items. */
308
309static void
310discard_menu_items ()
311{
312 /* Free the structure if it is especially large.
313 Otherwise, hold on to it, to save time. */
314 if (menu_items_allocated > 200)
315 {
316 menu_items = Qnil;
317 menu_items_allocated = 0;
318 }
319}
320
321/* Make the menu_items vector twice as large. */
322
323static void
324grow_menu_items ()
325{
326 Lisp_Object old;
327 int old_size = menu_items_allocated;
328 old = menu_items;
329
330 menu_items_allocated *= 2;
331 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
332 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
333 old_size * sizeof (Lisp_Object));
334}
335
336/* Begin a submenu. */
337
338static void
339push_submenu_start ()
340{
341 if (menu_items_used + 1 > menu_items_allocated)
342 grow_menu_items ();
343
344 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
345 menu_items_submenu_depth++;
346}
347
348/* End a submenu. */
349
350static void
351push_submenu_end ()
352{
353 if (menu_items_used + 1 > menu_items_allocated)
354 grow_menu_items ();
355
356 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
357 menu_items_submenu_depth--;
358}
359
360/* Indicate boundary between left and right. */
361
362static void
363push_left_right_boundary ()
364{
365 if (menu_items_used + 1 > menu_items_allocated)
366 grow_menu_items ();
367
368 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
369}
370
e0f712ba 371/* Start a new menu pane in menu_items.
1a578e9b
AC
372 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
373
374static void
375push_menu_pane (name, prefix_vec)
376 Lisp_Object name, prefix_vec;
377{
378 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
379 grow_menu_items ();
380
381 if (menu_items_submenu_depth == 0)
382 menu_items_n_panes++;
383 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
384 XVECTOR (menu_items)->contents[menu_items_used++] = name;
385 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
386}
387
388/* Push one menu item into the current pane. NAME is the string to
389 display. ENABLE if non-nil means this item can be selected. KEY
390 is the key generated by choosing this item, or nil if this item
391 doesn't really have a definition. DEF is the definition of this
392 item. EQUIV is the textual description of the keyboard equivalent
393 for this item (or nil if none). TYPE is the type of this menu
394 item, one of nil, `toggle' or `radio'. */
395
396static void
397push_menu_item (name, enable, key, def, equiv, type, selected, help)
398 Lisp_Object name, enable, key, def, equiv, type, selected, help;
399{
400 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
401 grow_menu_items ();
402
403 XVECTOR (menu_items)->contents[menu_items_used++] = name;
404 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
405 XVECTOR (menu_items)->contents[menu_items_used++] = key;
406 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
407 XVECTOR (menu_items)->contents[menu_items_used++] = def;
408 XVECTOR (menu_items)->contents[menu_items_used++] = type;
409 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
410 XVECTOR (menu_items)->contents[menu_items_used++] = help;
411}
412\f
413/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
414 and generate menu panes for them in menu_items.
415 If NOTREAL is nonzero,
416 don't bother really computing whether an item is enabled. */
417
418static void
419keymap_panes (keymaps, nmaps, notreal)
420 Lisp_Object *keymaps;
421 int nmaps;
422 int notreal;
423{
424 int mapno;
425
426 init_menu_items ();
427
428 /* Loop over the given keymaps, making a pane for each map.
429 But don't make a pane that is empty--ignore that map instead.
430 P is the number of panes we have made so far. */
431 for (mapno = 0; mapno < nmaps; mapno++)
e0f712ba
AC
432 single_keymap_panes (keymaps[mapno],
433 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
1a578e9b
AC
434
435 finish_menu_items ();
436}
437
438/* This is a recursive subroutine of keymap_panes.
439 It handles one keymap, KEYMAP.
440 The other arguments are passed along
441 or point to local variables of the previous function.
442 If NOTREAL is nonzero, only check for equivalent key bindings, don't
443 evaluate expressions in menu items and don't make any menu.
444
445 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
446
447static void
448single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
449 Lisp_Object keymap;
450 Lisp_Object pane_name;
451 Lisp_Object prefix;
452 int notreal;
453 int maxdepth;
454{
455 Lisp_Object pending_maps = Qnil;
456 Lisp_Object tail, item;
457 struct gcpro gcpro1, gcpro2;
458
459 if (maxdepth <= 0)
460 return;
461
462 push_menu_pane (pane_name, prefix);
463
464 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
465 {
466 GCPRO2 (keymap, pending_maps);
467 /* Look at each key binding, and if it is a menu item add it
468 to this menu. */
469 item = XCAR (tail);
470 if (CONSP (item))
471 single_menu_item (XCAR (item), XCDR (item),
472 &pending_maps, notreal, maxdepth);
473 else if (VECTORP (item))
474 {
475 /* Loop over the char values represented in the vector. */
476 int len = XVECTOR (item)->size;
477 int c;
478 for (c = 0; c < len; c++)
479 {
480 Lisp_Object character;
481 XSETFASTINT (character, c);
482 single_menu_item (character, XVECTOR (item)->contents[c],
483 &pending_maps, notreal, maxdepth);
484 }
485 }
486 UNGCPRO;
487 }
488
489 /* Process now any submenus which want to be panes at this level. */
490 while (!NILP (pending_maps))
491 {
492 Lisp_Object elt, eltcdr, string;
493 elt = Fcar (pending_maps);
494 eltcdr = XCDR (elt);
495 string = XCAR (eltcdr);
496 /* We no longer discard the @ from the beginning of the string here.
497 Instead, we do this in mac_menu_show. */
498 single_keymap_panes (Fcar (elt), string,
499 XCDR (eltcdr), notreal, maxdepth - 1);
500 pending_maps = Fcdr (pending_maps);
501 }
502}
503\f
504/* This is a subroutine of single_keymap_panes that handles one
505 keymap entry.
506 KEY is a key in a keymap and ITEM is its binding.
507 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
508 separate panes.
509 If NOTREAL is nonzero, only check for equivalent key bindings, don't
510 evaluate expressions in menu items and don't make any menu.
511 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
512
513static void
514single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
515 Lisp_Object key, item;
516 Lisp_Object *pending_maps_ptr;
517 int maxdepth, notreal;
518{
519 Lisp_Object map, item_string, enabled;
520 struct gcpro gcpro1, gcpro2;
521 int res;
522
523 /* Parse the menu item and leave the result in item_properties. */
524 GCPRO2 (key, item);
525 res = parse_menu_item (item, notreal, 0);
526 UNGCPRO;
527 if (!res)
528 return; /* Not a menu item. */
529
530 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
531
532 if (notreal)
533 {
534 /* We don't want to make a menu, just traverse the keymaps to
535 precompute equivalent key bindings. */
536 if (!NILP (map))
537 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
538 return;
539 }
540
541 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
542 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
543
544 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
545 {
546 if (!NILP (enabled))
547 /* An enabled separate pane. Remember this to handle it later. */
548 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
549 *pending_maps_ptr);
550 return;
551 }
552
553 push_menu_item (item_string, enabled, key,
554 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
555 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
556 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
557 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
558 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
559
560 /* Display a submenu using the toolkit. */
561 if (! (NILP (map) || NILP (enabled)))
562 {
563 push_submenu_start ();
564 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
565 push_submenu_end ();
566 }
567}
568\f
569/* Push all the panes and items of a menu described by the
570 alist-of-alists MENU.
571 This handles old-fashioned calls to x-popup-menu. */
572
573static void
574list_of_panes (menu)
575 Lisp_Object menu;
576{
577 Lisp_Object tail;
578
579 init_menu_items ();
580
581 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
582 {
583 Lisp_Object elt, pane_name, pane_data;
584 elt = Fcar (tail);
585 pane_name = Fcar (elt);
e0f712ba 586 CHECK_STRING (pane_name);
1a578e9b
AC
587 push_menu_pane (pane_name, Qnil);
588 pane_data = Fcdr (elt);
e0f712ba 589 CHECK_CONS (pane_data);
1a578e9b
AC
590 list_of_items (pane_data);
591 }
592
593 finish_menu_items ();
594}
595
596/* Push the items in a single pane defined by the alist PANE. */
597
598static void
599list_of_items (pane)
600 Lisp_Object pane;
601{
602 Lisp_Object tail, item, item1;
603
604 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
605 {
606 item = Fcar (tail);
607 if (STRINGP (item))
608 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
609 else if (NILP (item))
610 push_left_right_boundary ();
611 else
612 {
e0f712ba 613 CHECK_CONS (item);
1a578e9b 614 item1 = Fcar (item);
e0f712ba 615 CHECK_STRING (item1);
1a578e9b
AC
616 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
617 }
618 }
619}
620\f
621DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
e0f712ba
AC
622 doc: /* Pop up a deck-of-cards menu and return user's selection.
623POSITION is a position specification. This is either a mouse button
624event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
625are positions in pixels from the top left corner of WINDOW's frame
626\(WINDOW may be a frame object instead of a window). This controls the
627position of the center of the first line in the first pane of the
628menu, not the top left of the menu as a whole. If POSITION is t, it
629means to use the current mouse position.
630
631MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
632The menu items come from key bindings that have a menu string as well as
633a definition; actually, the \"definition\" in such a key binding looks like
634\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
635the keymap as a top-level element.
636
637If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
638Otherwise, REAL-DEFINITION should be a valid key binding definition.
639
640You can also use a list of keymaps as MENU. Then each keymap makes a
641separate pane. When MENU is a keymap or a list of keymaps, the return
642value is a list of events.
643
644Alternatively, you can specify a menu of multiple panes with a list of
645the form (TITLE PANE1 PANE2...), where each pane is a list of
646form (TITLE ITEM1 ITEM2...).
647Each ITEM is normally a cons cell (STRING . VALUE); but a string can
648appear as an item--that makes a nonselectable line in the menu.
649With this form of menu, the return value is VALUE from the chosen item.
650
651If POSITION is nil, don't display the menu at all, just precalculate the
652cached information about equivalent key sequences. */)
1a578e9b
AC
653 (position, menu)
654 Lisp_Object position, menu;
655{
656 Lisp_Object keymap, tem;
e0f712ba 657 int xpos = 0, ypos = 0;
1a578e9b
AC
658 Lisp_Object title;
659 char *error_name;
660 Lisp_Object selection;
e0f712ba 661 FRAME_PTR f = NULL;
1a578e9b
AC
662 Lisp_Object x, y, window;
663 int keymaps = 0;
664 int for_click = 0;
665 struct gcpro gcpro1;
666
667#ifdef HAVE_MENUS
668 if (! NILP (position))
669 {
670 check_mac ();
671
672 /* Decode the first argument: find the window and the coordinates. */
673 if (EQ (position, Qt)
e0f712ba
AC
674 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
675 || EQ (XCAR (position), Qtool_bar))))
1a578e9b
AC
676 {
677 /* Use the mouse's current position. */
678 FRAME_PTR new_f = SELECTED_FRAME ();
679 Lisp_Object bar_window;
680 enum scroll_bar_part part;
681 unsigned long time;
682
683 if (mouse_position_hook)
684 (*mouse_position_hook) (&new_f, 1, &bar_window,
685 &part, &x, &y, &time);
686 if (new_f != 0)
687 XSETFRAME (window, new_f);
688 else
689 {
690 window = selected_window;
691 XSETFASTINT (x, 0);
692 XSETFASTINT (y, 0);
693 }
694 }
695 else
696 {
697 tem = Fcar (position);
698 if (CONSP (tem))
699 {
700 window = Fcar (Fcdr (position));
701 x = Fcar (tem);
702 y = Fcar (Fcdr (tem));
703 }
704 else
705 {
706 for_click = 1;
707 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
708 window = Fcar (tem); /* POSN_WINDOW (tem) */
709 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
710 x = Fcar (tem);
711 y = Fcdr (tem);
712 }
713 }
714
e0f712ba
AC
715 CHECK_NUMBER (x);
716 CHECK_NUMBER (y);
1a578e9b
AC
717
718 /* Decode where to put the menu. */
719
720 if (FRAMEP (window))
721 {
722 f = XFRAME (window);
723 xpos = 0;
724 ypos = 0;
725 }
726 else if (WINDOWP (window))
727 {
e0f712ba 728 CHECK_LIVE_WINDOW (window);
1a578e9b
AC
729 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
730
731 xpos = (FONT_WIDTH (FRAME_FONT (f))
732 * XFASTINT (XWINDOW (window)->left));
733 ypos = (FRAME_LINE_HEIGHT (f)
734 * XFASTINT (XWINDOW (window)->top));
735 }
736 else
737 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
738 but I don't want to make one now. */
e0f712ba 739 CHECK_WINDOW (window);
1a578e9b
AC
740
741 xpos += XINT (x);
742 ypos += XINT (y);
743
744 XSETFRAME (Vmenu_updating_frame, f);
745 }
746 Vmenu_updating_frame = Qnil;
747#endif /* HAVE_MENUS */
748
749 title = Qnil;
750 GCPRO1 (title);
751
752 /* Decode the menu items from what was specified. */
753
e0f712ba
AC
754 keymap = get_keymap (menu, 0, 0);
755 if (CONSP (keymap))
1a578e9b
AC
756 {
757 /* We were given a keymap. Extract menu info from the keymap. */
758 Lisp_Object prompt;
1a578e9b
AC
759
760 /* Extract the detailed info to make one pane. */
761 keymap_panes (&menu, 1, NILP (position));
762
763 /* Search for a string appearing directly as an element of the keymap.
764 That string is the title of the menu. */
0c5b23f8 765 prompt = Fkeymap_prompt (keymap);
1a578e9b
AC
766 if (NILP (title) && !NILP (prompt))
767 title = prompt;
768
769 /* Make that be the pane title of the first pane. */
770 if (!NILP (prompt) && menu_items_n_panes >= 0)
771 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
772
773 keymaps = 1;
774 }
e0f712ba 775 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1a578e9b
AC
776 {
777 /* We were given a list of keymaps. */
778 int nmaps = XFASTINT (Flength (menu));
779 Lisp_Object *maps
780 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
781 int i;
782
783 title = Qnil;
784
785 /* The first keymap that has a prompt string
786 supplies the menu title. */
787 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
788 {
789 Lisp_Object prompt;
790
e0f712ba 791 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
1a578e9b 792
0c5b23f8 793 prompt = Fkeymap_prompt (keymap);
1a578e9b
AC
794 if (NILP (title) && !NILP (prompt))
795 title = prompt;
796 }
797
798 /* Extract the detailed info to make one pane. */
799 keymap_panes (maps, nmaps, NILP (position));
800
801 /* Make the title be the pane title of the first pane. */
802 if (!NILP (title) && menu_items_n_panes >= 0)
803 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
804
805 keymaps = 1;
806 }
807 else
808 {
809 /* We were given an old-fashioned menu. */
810 title = Fcar (menu);
e0f712ba 811 CHECK_STRING (title);
1a578e9b
AC
812
813 list_of_panes (Fcdr (menu));
814
815 keymaps = 0;
816 }
817
818 if (NILP (position))
819 {
820 discard_menu_items ();
821 UNGCPRO;
822 return Qnil;
823 }
824
825#ifdef HAVE_MENUS
826 /* Display them in a menu. */
827 BLOCK_INPUT;
828
829 selection = mac_menu_show (f, xpos, ypos, for_click,
830 keymaps, title, &error_name);
831 UNBLOCK_INPUT;
832
833 discard_menu_items ();
834
835 UNGCPRO;
836#endif /* HAVE_MENUS */
837
838 if (error_name) error (error_name);
839 return selection;
840}
841
842#ifdef HAVE_MENUS
843
844DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
e0f712ba
AC
845 doc: /* Pop up a dialog box and return user's selection.
846POSITION specifies which frame to use.
847This is normally a mouse button event or a window or frame.
848If POSITION is t, it means to use the frame the mouse is on.
849The dialog box appears in the middle of the specified frame.
850
851CONTENTS specifies the alternatives to display in the dialog box.
852It is a list of the form (TITLE ITEM1 ITEM2...).
853Each ITEM is a cons cell (STRING . VALUE).
854The return value is VALUE from the chosen item.
855
856An ITEM may also be just a string--that makes a nonselectable item.
857An ITEM may also be nil--that means to put all preceding items
858on the left of the dialog box and all following items on the right.
859\(By default, approximately half appear on each side.) */)
1a578e9b
AC
860 (position, contents)
861 Lisp_Object position, contents;
862{
e0f712ba 863 FRAME_PTR f = NULL;
1a578e9b
AC
864 Lisp_Object window;
865
866 check_mac ();
867
868 /* Decode the first argument: find the window or frame to use. */
869 if (EQ (position, Qt)
e0f712ba
AC
870 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
871 || EQ (XCAR (position), Qtool_bar))))
1a578e9b
AC
872 {
873#if 0 /* Using the frame the mouse is on may not be right. */
874 /* Use the mouse's current position. */
875 FRAME_PTR new_f = SELECTED_FRAME ();
876 Lisp_Object bar_window;
e0f712ba 877 enum scroll_bar_part part;
1a578e9b
AC
878 unsigned long time;
879 Lisp_Object x, y;
880
881 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
882
883 if (new_f != 0)
884 XSETFRAME (window, new_f);
885 else
886 window = selected_window;
887#endif
888 window = selected_window;
889 }
890 else if (CONSP (position))
891 {
892 Lisp_Object tem;
893 tem = Fcar (position);
894 if (CONSP (tem))
895 window = Fcar (Fcdr (position));
896 else
897 {
898 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
899 window = Fcar (tem); /* POSN_WINDOW (tem) */
900 }
901 }
902 else if (WINDOWP (position) || FRAMEP (position))
903 window = position;
904 else
905 window = Qnil;
906
907 /* Decode where to put the menu. */
908
909 if (FRAMEP (window))
910 f = XFRAME (window);
911 else if (WINDOWP (window))
912 {
e0f712ba 913 CHECK_LIVE_WINDOW (window);
1a578e9b
AC
914 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
915 }
916 else
917 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
918 but I don't want to make one now. */
e0f712ba 919 CHECK_WINDOW (window);
1a578e9b
AC
920
921#ifndef HAVE_DIALOGS
922 /* Display a menu with these alternatives
923 in the middle of frame F. */
924 {
925 Lisp_Object x, y, frame, newpos;
926 XSETFRAME (frame, f);
927 XSETINT (x, x_pixel_width (f) / 2);
928 XSETINT (y, x_pixel_height (f) / 2);
929 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
930
931 return Fx_popup_menu (newpos,
932 Fcons (Fcar (contents), Fcons (contents, Qnil)));
933 }
934#else /* HAVE_DIALOGS */
935 {
936 Lisp_Object title;
937 char *error_name;
938 Lisp_Object selection;
939
940 /* Decode the dialog items from what was specified. */
941 title = Fcar (contents);
e0f712ba 942 CHECK_STRING (title);
1a578e9b
AC
943
944 list_of_panes (Fcons (contents, Qnil));
945
946 /* Display them in a dialog box. */
947 BLOCK_INPUT;
948 selection = mac_dialog_show (f, 0, title, &error_name);
949 UNBLOCK_INPUT;
950
951 discard_menu_items ();
952
953 if (error_name) error (error_name);
954 return selection;
955 }
956#endif /* HAVE_DIALOGS */
957}
958
959/* Activate the menu bar of frame F.
960 This is called from keyboard.c when it gets the
b3e8cc4d 961 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1a578e9b
AC
962
963 To activate the menu bar, we signal to the input thread that it can
964 return from the WM_INITMENU message, allowing the normal Windows
965 processing of the menus.
966
967 But first we recompute the menu bar contents (the whole tree).
968
969 This way we can safely execute Lisp code. */
970
971void
972x_activate_menubar (f)
973 FRAME_PTR f;
974{
975 SInt32 menu_choice;
976 extern Point saved_menu_event_location;
977
978 set_frame_menubar (f, 0, 1);
979 BLOCK_INPUT;
980
981 menu_choice = MenuSelect (saved_menu_event_location);
982 do_menu_choice (menu_choice);
983
984 UNBLOCK_INPUT;
985}
986
987/* This callback is called from the menu bar pulldown menu
988 when the user makes a selection.
989 Figure out what the user chose
990 and put the appropriate events into the keyboard buffer. */
991
992void
993menubar_selection_callback (FRAME_PTR f, int client_data)
994{
995 Lisp_Object prefix, entry;
996 Lisp_Object vector;
997 Lisp_Object *subprefix_stack;
998 int submenu_depth = 0;
999 int i;
1000
1001 if (!f)
1002 return;
e0f712ba 1003 entry = Qnil;
1a578e9b
AC
1004 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1005 vector = f->menu_bar_vector;
1006 prefix = Qnil;
1007 i = 0;
1008 while (i < f->menu_bar_items_used)
1009 {
1010 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1011 {
1012 subprefix_stack[submenu_depth++] = prefix;
1013 prefix = entry;
1014 i++;
1015 }
1016 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1017 {
1018 prefix = subprefix_stack[--submenu_depth];
1019 i++;
1020 }
1021 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1022 {
1023 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1024 i += MENU_ITEMS_PANE_LENGTH;
1025 }
1026 else
1027 {
1028 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
e0f712ba
AC
1029 /* The EMACS_INT cast avoids a warning. There's no problem
1030 as long as pointers have enough bits to hold small integers. */
1031 if ((int) (EMACS_INT) client_data == i)
1a578e9b
AC
1032 {
1033 int j;
1034 struct input_event buf;
1035 Lisp_Object frame;
1036
1037 XSETFRAME (frame, f);
1038 buf.kind = MENU_BAR_EVENT;
1039 buf.frame_or_window = frame;
1040 buf.arg = frame;
1041 kbd_buffer_store_event (&buf);
1042
1043 for (j = 0; j < submenu_depth; j++)
1044 if (!NILP (subprefix_stack[j]))
1045 {
1046 buf.kind = MENU_BAR_EVENT;
1047 buf.frame_or_window = frame;
1048 buf.arg = subprefix_stack[j];
1049 kbd_buffer_store_event (&buf);
1050 }
1051
1052 if (!NILP (prefix))
1053 {
1054 buf.kind = MENU_BAR_EVENT;
1055 buf.frame_or_window = frame;
1056 buf.arg = prefix;
1057 kbd_buffer_store_event (&buf);
1058 }
1059
1060 buf.kind = MENU_BAR_EVENT;
1061 buf.frame_or_window = frame;
1062 buf.arg = entry;
1063 kbd_buffer_store_event (&buf);
1064
e0f712ba
AC
1065 f->output_data.mac->menu_command_in_progress = 0;
1066 f->output_data.mac->menubar_active = 0;
1a578e9b
AC
1067 return;
1068 }
1069 i += MENU_ITEMS_ITEM_LENGTH;
1070 }
1071 }
e0f712ba
AC
1072 f->output_data.mac->menu_command_in_progress = 0;
1073 f->output_data.mac->menubar_active = 0;
1a578e9b
AC
1074}
1075
1076/* Allocate a widget_value, blocking input. */
1077
1078widget_value *
1079xmalloc_widget_value ()
1080{
1081 widget_value *value;
1082
1083 BLOCK_INPUT;
1084 value = malloc_widget_value ();
1085 UNBLOCK_INPUT;
1086
1087 return value;
1088}
1089
1090/* This recursively calls free_widget_value on the tree of widgets.
1091 It must free all data that was malloc'ed for these widget_values.
1092 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1093 must be left alone. */
1094
1095void
1096free_menubar_widget_value_tree (wv)
1097 widget_value *wv;
1098{
1099 if (! wv) return;
1100
1101 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1102
1103 if (wv->contents && (wv->contents != (widget_value*)1))
1104 {
1105 free_menubar_widget_value_tree (wv->contents);
1106 wv->contents = (widget_value *) 0xDEADBEEF;
1107 }
1108 if (wv->next)
1109 {
1110 free_menubar_widget_value_tree (wv->next);
1111 wv->next = (widget_value *) 0xDEADBEEF;
1112 }
1113 BLOCK_INPUT;
1114 free_widget_value (wv);
1115 UNBLOCK_INPUT;
1116}
1117\f
1118/* Return a tree of widget_value structures for a menu bar item
1119 whose event type is ITEM_KEY (with string ITEM_NAME)
1120 and whose contents come from the list of keymaps MAPS. */
1121
1122static widget_value *
1123single_submenu (item_key, item_name, maps)
1124 Lisp_Object item_key, item_name, maps;
1125{
1126 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1127 int i;
1128 int submenu_depth = 0;
1129 Lisp_Object length;
1130 int len;
1131 Lisp_Object *mapvec;
1132 widget_value **submenu_stack;
1133 int previous_items = menu_items_used;
1134 int top_level_items = 0;
1135
1136 length = Flength (maps);
1137 len = XINT (length);
1138
1139 /* Convert the list MAPS into a vector MAPVEC. */
1140 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1141 for (i = 0; i < len; i++)
1142 {
1143 mapvec[i] = Fcar (maps);
1144 maps = Fcdr (maps);
1145 }
1146
1147 menu_items_n_panes = 0;
1148
1149 /* Loop over the given keymaps, making a pane for each map.
1150 But don't make a pane that is empty--ignore that map instead. */
1151 for (i = 0; i < len; i++)
1152 {
1153 if (SYMBOLP (mapvec[i])
e0f712ba 1154 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1a578e9b
AC
1155 {
1156 /* Here we have a command at top level in the menu bar
1157 as opposed to a submenu. */
1158 top_level_items = 1;
1159 push_menu_pane (Qnil, Qnil);
1160 push_menu_item (item_name, Qt, item_key, mapvec[i],
1161 Qnil, Qnil, Qnil, Qnil);
1162 }
1163 else
1164 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1165 }
1166
1167 /* Create a tree of widget_value objects
1168 representing the panes and their items. */
1169
1170 submenu_stack
1171 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1172 wv = xmalloc_widget_value ();
1173 wv->name = "menu";
1174 wv->value = 0;
1175 wv->enabled = 1;
1176 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1177 wv->help = Qnil;
1a578e9b
AC
1178 first_wv = wv;
1179 save_wv = 0;
1180 prev_wv = 0;
1181
1182 /* Loop over all panes and items made during this call
1183 and construct a tree of widget_value objects.
1184 Ignore the panes and items made by previous calls to
1185 single_submenu, even though those are also in menu_items. */
1186 i = previous_items;
1187 while (i < menu_items_used)
1188 {
1189 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1190 {
1191 submenu_stack[submenu_depth++] = save_wv;
1192 save_wv = prev_wv;
1193 prev_wv = 0;
1194 i++;
1195 }
1196 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1197 {
1198 prev_wv = save_wv;
1199 save_wv = submenu_stack[--submenu_depth];
1200 i++;
1201 }
1202 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1203 && submenu_depth != 0)
1204 i += MENU_ITEMS_PANE_LENGTH;
1205 /* Ignore a nil in the item list.
1206 It's meaningful only for dialog boxes. */
1207 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1208 i += 1;
1209 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1210 {
1211 /* Create a new pane. */
1212 Lisp_Object pane_name, prefix;
1213 char *pane_string;
e0f712ba 1214
1a578e9b
AC
1215 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1216 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
e0f712ba 1217
1a578e9b
AC
1218#ifndef HAVE_MULTILINGUAL_MENU
1219 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
e0f712ba
AC
1220 {
1221 pane_name = ENCODE_SYSTEM (pane_name);
1222 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1223 }
1a578e9b
AC
1224#endif
1225 pane_string = (NILP (pane_name)
1226 ? "" : (char *) XSTRING (pane_name)->data);
1227 /* If there is just one top-level pane, put all its items directly
1228 under the top-level menu. */
1229 if (menu_items_n_panes == 1)
1230 pane_string = "";
1231
1232 /* If the pane has a meaningful name,
1233 make the pane a top-level menu item
1234 with its items as a submenu beneath it. */
1235 if (strcmp (pane_string, ""))
1236 {
1237 wv = xmalloc_widget_value ();
1238 if (save_wv)
1239 save_wv->next = wv;
1240 else
1241 first_wv->contents = wv;
1242 wv->name = pane_string;
1243 /* Ignore the @ that means "separate pane".
1244 This is a kludge, but this isn't worth more time. */
1245 if (!NILP (prefix) && wv->name[0] == '@')
1246 wv->name++;
1247 wv->value = 0;
1248 wv->enabled = 1;
1249 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1250 wv->help = Qnil;
1a578e9b
AC
1251 }
1252 save_wv = wv;
1253 prev_wv = 0;
1254 i += MENU_ITEMS_PANE_LENGTH;
1255 }
1256 else
1257 {
1258 /* Create a new item within current pane. */
1259 Lisp_Object item_name, enable, descrip, def, type, selected;
1260 Lisp_Object help;
1261
e0f712ba
AC
1262 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1263 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1264 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1265 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1266 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1267 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1268 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1a578e9b
AC
1269
1270#ifndef HAVE_MULTILINGUAL_MENU
e0f712ba
AC
1271 if (STRING_MULTIBYTE (item_name))
1272 {
1273 item_name = ENCODE_SYSTEM (item_name);
1274 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1275 }
1276
1277 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1278 {
1279 descrip = ENCODE_SYSTEM (descrip);
1280 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1281 }
1282#endif /* not HAVE_MULTILINGUAL_MENU */
1a578e9b
AC
1283
1284 wv = xmalloc_widget_value ();
1285 if (prev_wv)
1286 prev_wv->next = wv;
1287 else
1288 save_wv->contents = wv;
1289
1290 wv->name = (char *) XSTRING (item_name)->data;
1291 if (!NILP (descrip))
1292 wv->key = (char *) XSTRING (descrip)->data;
1293 wv->value = 0;
1294 /* The EMACS_INT cast avoids a warning. There's no problem
1295 as long as pointers have enough bits to hold small integers. */
1296 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1297 wv->enabled = !NILP (enable);
1298
1299 if (NILP (type))
1300 wv->button_type = BUTTON_TYPE_NONE;
1301 else if (EQ (type, QCradio))
1302 wv->button_type = BUTTON_TYPE_RADIO;
1303 else if (EQ (type, QCtoggle))
1304 wv->button_type = BUTTON_TYPE_TOGGLE;
1305 else
1306 abort ();
1307
1308 wv->selected = !NILP (selected);
e0f712ba
AC
1309 if (!STRINGP (help))
1310 help = Qnil;
1311
1312 wv->help = help;
1a578e9b
AC
1313
1314 prev_wv = wv;
1315
1316 i += MENU_ITEMS_ITEM_LENGTH;
1317 }
1318 }
1319
1320 /* If we have just one "menu item"
1321 that was originally a button, return it by itself. */
1322 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1323 {
1324 wv = first_wv->contents;
1325 free_widget_value (first_wv);
1326 return wv;
1327 }
1328
1329 return first_wv;
1330}
1331\f
1332/* Set the contents of the menubar widgets of frame F.
1333 The argument FIRST_TIME is currently ignored;
1334 it is set the first time this is called, from initialize_frame_menubar. */
1335
1336void
1337set_frame_menubar (f, first_time, deep_p)
1338 FRAME_PTR f;
1339 int first_time;
1340 int deep_p;
1341{
1342 int menubar_widget = f->output_data.mac->menubar_widget;
1343 Lisp_Object items;
1344 widget_value *wv, *first_wv, *prev_wv = 0;
1345 int i;
1346
e0f712ba
AC
1347 /* We must not change the menubar when actually in use. */
1348 if (f->output_data.mac->menubar_active)
1349 return;
1350
1a578e9b
AC
1351 XSETFRAME (Vmenu_updating_frame, f);
1352
e0f712ba
AC
1353 if (! menubar_widget)
1354 deep_p = 1;
1355 else if (pending_menu_activation && !deep_p)
1356 deep_p = 1;
1357
1a578e9b
AC
1358 wv = xmalloc_widget_value ();
1359 wv->name = "menubar";
1360 wv->value = 0;
1361 wv->enabled = 1;
1362 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1363 wv->help = Qnil;
1a578e9b
AC
1364 first_wv = wv;
1365
e0f712ba
AC
1366 if (deep_p)
1367 {
1368 /* Make a widget-value tree representing the entire menu trees. */
1369
1370 struct buffer *prev = current_buffer;
1371 Lisp_Object buffer;
aed13378 1372 int specpdl_count = SPECPDL_INDEX ();
e0f712ba
AC
1373 int previous_menu_items_used = f->menu_bar_items_used;
1374 Lisp_Object *previous_items
1375 = (Lisp_Object *) alloca (previous_menu_items_used
1376 * sizeof (Lisp_Object));
1377
1378 /* If we are making a new widget, its contents are empty,
1379 do always reinitialize them. */
1380 if (! menubar_widget)
1381 previous_menu_items_used = 0;
1382
1383 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1384 specbind (Qinhibit_quit, Qt);
1385 /* Don't let the debugger step into this code
1386 because it is not reentrant. */
1387 specbind (Qdebug_on_next_call, Qnil);
1388
1389 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1390 if (NILP (Voverriding_local_map_menu_flag))
1391 {
1392 specbind (Qoverriding_terminal_local_map, Qnil);
1393 specbind (Qoverriding_local_map, Qnil);
1394 }
1a578e9b 1395
e0f712ba 1396 set_buffer_internal_1 (XBUFFER (buffer));
1a578e9b 1397
e0f712ba
AC
1398 /* Run the Lucid hook. */
1399 safe_run_hooks (Qactivate_menubar_hook);
1400 /* If it has changed current-menubar from previous value,
1401 really recompute the menubar from the value. */
1402 if (! NILP (Vlucid_menu_bar_dirty_flag))
1403 call0 (Qrecompute_lucid_menubar);
1404 safe_run_hooks (Qmenu_bar_update_hook);
1405 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1a578e9b 1406
e0f712ba 1407 items = FRAME_MENU_BAR_ITEMS (f);
1a578e9b 1408
e0f712ba 1409 inhibit_garbage_collection ();
1a578e9b 1410
e0f712ba
AC
1411 /* Save the frame's previous menu bar contents data. */
1412 if (previous_menu_items_used)
1413 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1414 previous_menu_items_used * sizeof (Lisp_Object));
1a578e9b 1415
e0f712ba
AC
1416 /* Fill in the current menu bar contents. */
1417 menu_items = f->menu_bar_vector;
1418 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1419 init_menu_items ();
1420 for (i = 0; i < XVECTOR (items)->size; i += 4)
1421 {
1422 Lisp_Object key, string, maps;
1423
1424 key = XVECTOR (items)->contents[i];
1425 string = XVECTOR (items)->contents[i + 1];
1426 maps = XVECTOR (items)->contents[i + 2];
1427 if (NILP (string))
1428 break;
1429
1430 wv = single_submenu (key, string, maps);
1431 if (prev_wv)
1432 prev_wv->next = wv;
1433 else
1434 first_wv->contents = wv;
1435 /* Don't set wv->name here; GC during the loop might relocate it. */
1436 wv->enabled = 1;
1437 wv->button_type = BUTTON_TYPE_NONE;
1438 prev_wv = wv;
1439 }
1440
1441 finish_menu_items ();
1a578e9b 1442
e0f712ba
AC
1443 set_buffer_internal_1 (prev);
1444 unbind_to (specpdl_count, Qnil);
1445
1446 /* If there has been no change in the Lisp-level contents
1447 of the menu bar, skip redisplaying it. Just exit. */
1448
1449 for (i = 0; i < previous_menu_items_used; i++)
1450 if (menu_items_used == i
1451 || (!Fequal (previous_items[i], XVECTOR (menu_items)->contents[i])))
1a578e9b 1452 break;
e0f712ba
AC
1453 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1454 {
1455 free_menubar_widget_value_tree (first_wv);
1456 menu_items = Qnil;
1a578e9b 1457
e0f712ba
AC
1458 return;
1459 }
1a578e9b 1460
e0f712ba
AC
1461 /* Now GC cannot happen during the lifetime of the widget_value,
1462 so it's safe to store data from a Lisp_String, as long as
1463 local copies are made when the actual menu is created.
1464 Windows takes care of this for normal string items, but
1465 not for owner-drawn items or additional item-info. */
1466 wv = first_wv->contents;
1467 for (i = 0; i < XVECTOR (items)->size; i += 4)
1468 {
1469 Lisp_Object string;
1470 string = XVECTOR (items)->contents[i + 1];
1471 if (NILP (string))
1472 break;
1473 wv->name = (char *) XSTRING (string)->data;
1474 wv = wv->next;
1475 }
1a578e9b 1476
e0f712ba
AC
1477 f->menu_bar_vector = menu_items;
1478 f->menu_bar_items_used = menu_items_used;
1479 menu_items = Qnil;
1480 }
1481 else
1482 {
1483 /* Make a widget-value tree containing
1484 just the top level menu bar strings. */
1a578e9b 1485
e0f712ba
AC
1486 items = FRAME_MENU_BAR_ITEMS (f);
1487 for (i = 0; i < XVECTOR (items)->size; i += 4)
1488 {
1489 Lisp_Object string;
1a578e9b 1490
e0f712ba
AC
1491 string = XVECTOR (items)->contents[i + 1];
1492 if (NILP (string))
1493 break;
1a578e9b 1494
e0f712ba
AC
1495 wv = xmalloc_widget_value ();
1496 wv->name = (char *) XSTRING (string)->data;
1497 wv->value = 0;
1498 wv->enabled = 1;
1499 wv->button_type = BUTTON_TYPE_NONE;
1500 wv->help = Qnil;
1501 /* This prevents lwlib from assuming this
1502 menu item is really supposed to be empty. */
1503 /* The EMACS_INT cast avoids a warning.
1504 This value just has to be different from small integers. */
1505 wv->call_data = (void *) (EMACS_INT) (-1);
1a578e9b 1506
e0f712ba
AC
1507 if (prev_wv)
1508 prev_wv->next = wv;
1509 else
1510 first_wv->contents = wv;
1511 prev_wv = wv;
1512 }
1a578e9b 1513
e0f712ba
AC
1514 /* Forget what we thought we knew about what is in the
1515 detailed contents of the menu bar menus.
1516 Changing the top level always destroys the contents. */
1517 f->menu_bar_items_used = 0;
1518 }
1a578e9b
AC
1519
1520 /* Create or update the menu bar widget. */
1521
1522 BLOCK_INPUT;
1523
e0f712ba
AC
1524 /* Non-null value to indicate menubar has already been "created". */
1525 f->output_data.mac->menubar_widget = 1;
1a578e9b
AC
1526
1527 {
1528 int i = MIN_MENU_ID;
1529 MenuHandle menu = GetMenuHandle (i);
1530 while (menu != NULL)
1531 {
e0f712ba
AC
1532 DeleteMenu (i);
1533 DisposeMenu (menu);
1534 menu = GetMenuHandle (++i);
1a578e9b 1535 }
e0f712ba 1536
1a578e9b
AC
1537 i = MIN_SUBMENU_ID;
1538 menu = GetMenuHandle (i);
1539 while (menu != NULL)
1540 {
e0f712ba
AC
1541 DeleteMenu (i);
1542 DisposeMenu (menu);
1543 menu = GetMenuHandle (++i);
1a578e9b
AC
1544 }
1545 }
1546
1547 fill_menubar (first_wv->contents);
1548
1549 DrawMenuBar ();
1550
1551 free_menubar_widget_value_tree (first_wv);
1552
1553 UNBLOCK_INPUT;
1554}
1555
e0f712ba
AC
1556/* Called from Fx_create_frame to create the initial menubar of a frame
1557 before it is mapped, so that the window is mapped with the menubar already
1558 there instead of us tacking it on later and thrashing the window after it
1559 is visible. */
1a578e9b
AC
1560
1561void
1562initialize_frame_menubar (f)
1563 FRAME_PTR f;
1564{
1565 /* This function is called before the first chance to redisplay
1566 the frame. It has to be, so the frame will have the right size. */
1567 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1568 set_frame_menubar (f, 1, 1);
1569}
1570
1571/* Get rid of the menu bar of frame F, and free its storage.
1572 This is used when deleting a frame, and when turning off the menu bar. */
1573
1574void
1575free_frame_menubar (f)
1576 FRAME_PTR f;
1577{
e0f712ba 1578 f->output_data.mac->menubar_widget = NULL;
1a578e9b
AC
1579}
1580
1581\f
1582/* mac_menu_show actually displays a menu using the panes and items in
1583 menu_items and returns the value selected from it; we assume input
1584 is blocked by the caller. */
1585
1586/* F is the frame the menu is for.
1587 X and Y are the frame-relative specified position,
1588 relative to the inside upper left corner of the frame F.
1589 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1590 KEYMAPS is 1 if this menu was specified with keymaps;
1591 in that case, we return a list containing the chosen item's value
1592 and perhaps also the pane's prefix.
1593 TITLE is the specified menu title.
1594 ERROR is a place to store an error message string in case of failure.
1595 (We return nil on failure, but the value doesn't actually matter.) */
1596
1597static Lisp_Object
1598mac_menu_show (f, x, y, for_click, keymaps, title, error)
1599 FRAME_PTR f;
1600 int x;
1601 int y;
1602 int for_click;
1603 int keymaps;
1604 Lisp_Object title;
1605 char **error;
1606{
1607 int i;
1608 int menu_item_selection;
1609 MenuHandle menu;
1610 Point pos;
1611 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1612 widget_value **submenu_stack
1613 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1614 Lisp_Object *subprefix_stack
1615 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1616 int submenu_depth = 0;
1617 int first_pane;
1a578e9b
AC
1618
1619 *error = NULL;
1620
1621 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1622 {
1623 *error = "Empty menu";
1624 return Qnil;
1625 }
1626
1627 /* Create a tree of widget_value objects
1628 representing the panes and their items. */
1629 wv = xmalloc_widget_value ();
1630 wv->name = "menu";
1631 wv->value = 0;
1632 wv->enabled = 1;
1633 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1634 wv->help = Qnil;
1a578e9b
AC
1635 first_wv = wv;
1636 first_pane = 1;
1637
1638 /* Loop over all panes and items, filling in the tree. */
1639 i = 0;
1640 while (i < menu_items_used)
1641 {
1642 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1643 {
1644 submenu_stack[submenu_depth++] = save_wv;
1645 save_wv = prev_wv;
1646 prev_wv = 0;
1647 first_pane = 1;
1648 i++;
1649 }
1650 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1651 {
1652 prev_wv = save_wv;
1653 save_wv = submenu_stack[--submenu_depth];
1654 first_pane = 0;
1655 i++;
1656 }
1657 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1658 && submenu_depth != 0)
1659 i += MENU_ITEMS_PANE_LENGTH;
1660 /* Ignore a nil in the item list.
1661 It's meaningful only for dialog boxes. */
1662 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1663 i += 1;
1664 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1665 {
1666 /* Create a new pane. */
1667 Lisp_Object pane_name, prefix;
1668 char *pane_string;
e0f712ba
AC
1669 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1670 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1a578e9b
AC
1671#ifndef HAVE_MULTILINGUAL_MENU
1672 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
e0f712ba
AC
1673 {
1674 pane_name = ENCODE_SYSTEM (pane_name);
1675 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1676 }
1a578e9b
AC
1677#endif
1678 pane_string = (NILP (pane_name)
1679 ? "" : (char *) XSTRING (pane_name)->data);
1680 /* If there is just one top-level pane, put all its items directly
1681 under the top-level menu. */
1682 if (menu_items_n_panes == 1)
1683 pane_string = "";
1684
1685 /* If the pane has a meaningful name,
1686 make the pane a top-level menu item
1687 with its items as a submenu beneath it. */
1688 if (!keymaps && strcmp (pane_string, ""))
1689 {
1690 wv = xmalloc_widget_value ();
1691 if (save_wv)
1692 save_wv->next = wv;
1693 else
1694 first_wv->contents = wv;
1695 wv->name = pane_string;
1696 if (keymaps && !NILP (prefix))
1697 wv->name++;
1698 wv->value = 0;
1699 wv->enabled = 1;
1700 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1701 wv->help = Qnil;
1a578e9b
AC
1702 save_wv = wv;
1703 prev_wv = 0;
1704 }
1705 else if (first_pane)
1706 {
1707 save_wv = wv;
1708 prev_wv = 0;
1709 }
1710 first_pane = 0;
1711 i += MENU_ITEMS_PANE_LENGTH;
1712 }
1713 else
1714 {
1715 /* Create a new item within current pane. */
1716 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1717
e0f712ba
AC
1718 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1719 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1720 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1721 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1722 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1723 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1724 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1a578e9b
AC
1725
1726#ifndef HAVE_MULTILINGUAL_MENU
e0f712ba
AC
1727 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1728 {
1729 item_name = ENCODE_SYSTEM (item_name);
1730 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1731 }
1a578e9b 1732 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
e0f712ba
AC
1733 {
1734 descrip = ENCODE_SYSTEM (descrip);
1735 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1736 }
1737#endif /* not HAVE_MULTILINGUAL_MENU */
1a578e9b
AC
1738
1739 wv = xmalloc_widget_value ();
1740 if (prev_wv)
1741 prev_wv->next = wv;
1742 else
1743 save_wv->contents = wv;
1744 wv->name = (char *) XSTRING (item_name)->data;
1745 if (!NILP (descrip))
1746 wv->key = (char *) XSTRING (descrip)->data;
1747 wv->value = 0;
1748 /* Use the contents index as call_data, since we are
e0f712ba 1749 restricted to 16-bits. */
1a578e9b
AC
1750 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1751 wv->enabled = !NILP (enable);
1752
1753 if (NILP (type))
1754 wv->button_type = BUTTON_TYPE_NONE;
1755 else if (EQ (type, QCtoggle))
1756 wv->button_type = BUTTON_TYPE_TOGGLE;
1757 else if (EQ (type, QCradio))
1758 wv->button_type = BUTTON_TYPE_RADIO;
1759 else
1760 abort ();
1761
1762 wv->selected = !NILP (selected);
e0f712ba
AC
1763 if (!STRINGP (help))
1764 help = Qnil;
1a578e9b 1765
e0f712ba 1766 wv->help = help;
1a578e9b
AC
1767
1768 prev_wv = wv;
1769
1770 i += MENU_ITEMS_ITEM_LENGTH;
1771 }
1772 }
1773
1774 /* Deal with the title, if it is non-nil. */
1775 if (!NILP (title))
1776 {
1777 widget_value *wv_title = xmalloc_widget_value ();
1778 widget_value *wv_sep = xmalloc_widget_value ();
1779
1780 /* Maybe replace this separator with a bitmap or owner-draw item
1781 so that it looks better. Having two separators looks odd. */
1782 wv_sep->name = "--";
1783 wv_sep->next = first_wv->contents;
e0f712ba 1784 wv_sep->help = Qnil;
1a578e9b
AC
1785
1786#ifndef HAVE_MULTILINGUAL_MENU
1787 if (STRING_MULTIBYTE (title))
e0f712ba 1788 title = ENCODE_SYSTEM (title);
1a578e9b
AC
1789#endif
1790 wv_title->name = (char *) XSTRING (title)->data;
e0f712ba
AC
1791 wv_title->enabled = TRUE;
1792 wv_title->title = TRUE;
1a578e9b 1793 wv_title->button_type = BUTTON_TYPE_NONE;
e0f712ba 1794 wv_title->help = Qnil;
1a578e9b
AC
1795 wv_title->next = wv_sep;
1796 first_wv->contents = wv_title;
1797 }
1798
1799 /* Actually create the menu. */
1800 menu = NewMenu (POPUP_SUBMENU_ID, "\p");
1801 fill_submenu (menu, first_wv->contents, 0);
1802
1803 /* Adjust coordinates to be root-window-relative. */
1804 pos.h = x;
1805 pos.v = y;
e0f712ba
AC
1806
1807#if TARGET_API_MAC_CARBON
1808 SetPort (GetWindowPort (FRAME_MAC_WINDOW (f)));
1809#else
1a578e9b 1810 SetPort (FRAME_MAC_WINDOW (f));
e0f712ba
AC
1811#endif
1812
1a578e9b
AC
1813 LocalToGlobal (&pos);
1814
e0f712ba
AC
1815 /* No selection has been chosen yet. */
1816 menu_item_selection = 0;
1817
1a578e9b
AC
1818 InsertMenu (menu, -1);
1819
1820 /* Display the menu. */
1821 menu_item_selection = LoWord (PopUpMenuSelect (menu, pos.v, pos.h, 0));
1822
1823 DeleteMenu (POPUP_SUBMENU_ID);
1824
1825#if 0
1826 /* Clean up extraneous mouse events which might have been generated
1827 during the call. */
1828 discard_mouse_events ();
1829#endif
1830
1831 /* Free the widget_value objects we used to specify the
1832 contents. */
1833 free_menubar_widget_value_tree (first_wv);
1834
1835 DisposeMenu (menu);
1836
e0f712ba
AC
1837 /* Find the selected item, and its pane, to return
1838 the proper value. */
1a578e9b
AC
1839 if (menu_item_selection != 0)
1840 {
1841 Lisp_Object prefix, entry;
1842
e0f712ba 1843 prefix = entry = Qnil;
1a578e9b
AC
1844 i = 0;
1845 while (i < menu_items_used)
1846 {
1847 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1848 {
1849 subprefix_stack[submenu_depth++] = prefix;
1850 prefix = entry;
1851 i++;
1852 }
1853 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1854 {
1855 prefix = subprefix_stack[--submenu_depth];
1856 i++;
1857 }
1858 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1859 {
1860 prefix
1861 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1862 i += MENU_ITEMS_PANE_LENGTH;
1863 }
e0f712ba
AC
1864 /* Ignore a nil in the item list.
1865 It's meaningful only for dialog boxes. */
1a578e9b
AC
1866 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1867 i += 1;
1868 else
1869 {
1870 entry
1871 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1872 if (menu_item_selection == i)
1873 {
1874 if (keymaps != 0)
1875 {
1876 int j;
1877
1878 entry = Fcons (entry, Qnil);
1879 if (!NILP (prefix))
1880 entry = Fcons (prefix, entry);
1881 for (j = submenu_depth - 1; j >= 0; j--)
1882 if (!NILP (subprefix_stack[j]))
1883 entry = Fcons (subprefix_stack[j], entry);
1884 }
1885 return entry;
1886 }
1887 i += MENU_ITEMS_ITEM_LENGTH;
1888 }
1889 }
1890 }
1891
1892 return Qnil;
1893}
1894\f
1895
e0f712ba 1896#ifdef HAVE_DIALOGS
1a578e9b
AC
1897/* Construct native Mac OS menubar based on widget_value tree. */
1898
1899static int
1900mac_dialog (widget_value *wv)
1901{
1902 char *dialog_name;
1903 char *prompt;
1904 char **button_labels;
1905 UInt32 *ref_cons;
1906 int nb_buttons;
1907 int left_count;
1908 int i;
1909 int dialog_width;
1910 Rect rect;
1911 WindowPtr window_ptr;
1912 ControlHandle ch;
1913 int left;
1914 EventRecord event_record;
1915 SInt16 part_code;
1916 int control_part_code;
1917 Point mouse;
1918
1919 dialog_name = wv->name;
1920 nb_buttons = dialog_name[1] - '0';
1921 left_count = nb_buttons - (dialog_name[4] - '0');
1922 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
e0f712ba 1923 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
1a578e9b
AC
1924
1925 wv = wv->contents;
1926 prompt = (char *) alloca (strlen (wv->value) + 1);
1927 strcpy (prompt, wv->value);
1928 c2pstr (prompt);
1929
1930 wv = wv->next;
1931 for (i = 0; i < nb_buttons; i++)
1932 {
1933 button_labels[i] = wv->value;
1934 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
1935 strcpy (button_labels[i], wv->value);
1936 c2pstr (button_labels[i]);
1937 ref_cons[i] = (UInt32) wv->call_data;
1938 wv = wv->next;
1939 }
1940
1941 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
e0f712ba
AC
1942
1943#if TARGET_API_MAC_CARBON
1944 SetPort (GetWindowPort (window_ptr));
1945#else
1a578e9b 1946 SetPort (window_ptr);
e0f712ba 1947#endif
1a578e9b
AC
1948
1949 TextFont (0);
1950 /* Left and right margins in the dialog are 13 pixels each.*/
1951 dialog_width = 14;
1952 /* Calculate width of dialog box: 8 pixels on each side of the text
1953 label in each button, 12 pixels between buttons. */
1954 for (i = 0; i < nb_buttons; i++)
1955 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
1956
1957 if (left_count != 0 && nb_buttons - left_count != 0)
1958 dialog_width += 12;
1959
1960 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
1961
1962 SizeWindow (window_ptr, dialog_width, 78, 0);
1963 ShowWindow (window_ptr);
1964
e0f712ba
AC
1965#if TARGET_API_MAC_CARBON
1966 SetPort (GetWindowPort (window_ptr));
1967#else
1a578e9b 1968 SetPort (window_ptr);
e0f712ba
AC
1969#endif
1970
1a578e9b
AC
1971 TextFont (0);
1972
1973 MoveTo (13, 29);
1974 DrawString (prompt);
1975
1976 left = 13;
1977 for (i = 0; i < nb_buttons; i++)
1978 {
1979 int button_width = StringWidth (button_labels[i]) + 16;
1980 SetRect (&rect, left, 45, left + button_width, 65);
1981 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
1982 kControlPushButtonProc, ref_cons[i]);
1983 left += button_width + 12;
1984 if (i == left_count - 1)
1985 left += 12;
1986 }
1987
1988 i = 0;
1989 while (!i)
1990 {
1991 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
1992 if (event_record.what == mouseDown)
1993 {
1994 part_code = FindWindow (event_record.where, &window_ptr);
1995 if (part_code == inContent)
1996 {
1997 mouse = event_record.where;
1998 GlobalToLocal (&mouse);
1999 control_part_code = FindControl (mouse, window_ptr, &ch);
2000 if (control_part_code == kControlButtonPart)
2001 if (TrackControl (ch, mouse, NULL))
2002 i = GetControlReference (ch);
2003 }
2004 }
2005 }
2006
2007 DisposeWindow (window_ptr);
2008
2009 return i;
2010}
2011
2012static char * button_names [] = {
2013 "button1", "button2", "button3", "button4", "button5",
2014 "button6", "button7", "button8", "button9", "button10" };
2015
2016static Lisp_Object
2017mac_dialog_show (f, keymaps, title, error)
2018 FRAME_PTR f;
2019 int keymaps;
2020 Lisp_Object title;
2021 char **error;
2022{
2023 int i, nb_buttons=0;
2024 char dialog_name[6];
2025 int menu_item_selection;
2026
e0f712ba 2027 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1a578e9b
AC
2028
2029 /* Number of elements seen so far, before boundary. */
2030 int left_count = 0;
e0f712ba 2031 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1a578e9b
AC
2032 int boundary_seen = 0;
2033
2034 *error = NULL;
2035
2036 if (menu_items_n_panes > 1)
2037 {
2038 *error = "Multiple panes in dialog box";
2039 return Qnil;
2040 }
2041
e0f712ba
AC
2042 /* Create a tree of widget_value objects
2043 representing the text label and buttons. */
1a578e9b
AC
2044 {
2045 Lisp_Object pane_name, prefix;
2046 char *pane_string;
2047 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2048 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2049 pane_string = (NILP (pane_name)
2050 ? "" : (char *) XSTRING (pane_name)->data);
2051 prev_wv = xmalloc_widget_value ();
2052 prev_wv->value = pane_string;
2053 if (keymaps && !NILP (prefix))
2054 prev_wv->name++;
2055 prev_wv->enabled = 1;
2056 prev_wv->name = "message";
e0f712ba 2057 prev_wv->help = Qnil;
1a578e9b
AC
2058 first_wv = prev_wv;
2059
2060 /* Loop over all panes and items, filling in the tree. */
2061 i = MENU_ITEMS_PANE_LENGTH;
2062 while (i < menu_items_used)
2063 {
2064
2065 /* Create a new item within current pane. */
2066 Lisp_Object item_name, enable, descrip, help;
2067
2068 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2069 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2070 descrip
2071 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2072 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
2073
2074 if (NILP (item_name))
2075 {
2076 free_menubar_widget_value_tree (first_wv);
2077 *error = "Submenu in dialog items";
2078 return Qnil;
2079 }
2080 if (EQ (item_name, Qquote))
2081 {
e0f712ba
AC
2082 /* This is the boundary between left-side elts
2083 and right-side elts. Stop incrementing right_count. */
1a578e9b
AC
2084 boundary_seen = 1;
2085 i++;
2086 continue;
2087 }
2088 if (nb_buttons >= 9)
2089 {
2090 free_menubar_widget_value_tree (first_wv);
2091 *error = "Too many dialog items";
2092 return Qnil;
2093 }
2094
2095 wv = xmalloc_widget_value ();
2096 prev_wv->next = wv;
2097 wv->name = (char *) button_names[nb_buttons];
2098 if (!NILP (descrip))
2099 wv->key = (char *) XSTRING (descrip)->data;
2100 wv->value = (char *) XSTRING (item_name)->data;
2101 wv->call_data = (void *) i;
2102 /* menu item is identified by its index in menu_items table */
2103 wv->enabled = !NILP (enable);
e0f712ba 2104 wv->help = Qnil;
1a578e9b
AC
2105 prev_wv = wv;
2106
2107 if (! boundary_seen)
2108 left_count++;
2109
2110 nb_buttons++;
2111 i += MENU_ITEMS_ITEM_LENGTH;
2112 }
2113
e0f712ba
AC
2114 /* If the boundary was not specified,
2115 by default put half on the left and half on the right. */
1a578e9b
AC
2116 if (! boundary_seen)
2117 left_count = nb_buttons - nb_buttons / 2;
2118
2119 wv = xmalloc_widget_value ();
2120 wv->name = dialog_name;
e0f712ba 2121 wv->help = Qnil;
1a578e9b 2122
e0f712ba
AC
2123 /* Dialog boxes use a really stupid name encoding
2124 which specifies how many buttons to use
2125 and how many buttons are on the right.
1a578e9b
AC
2126 The Q means something also. */
2127 dialog_name[0] = 'Q';
2128 dialog_name[1] = '0' + nb_buttons;
2129 dialog_name[2] = 'B';
2130 dialog_name[3] = 'R';
2131 /* Number of buttons to put on the right. */
2132 dialog_name[4] = '0' + nb_buttons - left_count;
2133 dialog_name[5] = 0;
2134 wv->contents = first_wv;
2135 first_wv = wv;
2136 }
2137
2138 /* Actually create the dialog. */
2139#ifdef HAVE_DIALOGS
2140 menu_item_selection = mac_dialog (first_wv);
2141#else
2142 menu_item_selection = 0;
2143#endif
2144
e0f712ba 2145 /* Free the widget_value objects we used to specify the contents. */
1a578e9b
AC
2146 free_menubar_widget_value_tree (first_wv);
2147
2148 /* Find the selected item, and its pane, to return the proper
2149 value. */
2150 if (menu_item_selection != 0)
2151 {
2152 Lisp_Object prefix;
2153
2154 prefix = Qnil;
2155 i = 0;
2156 while (i < menu_items_used)
2157 {
2158 Lisp_Object entry;
2159
2160 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2161 {
2162 prefix
2163 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2164 i += MENU_ITEMS_PANE_LENGTH;
2165 }
2166 else
2167 {
2168 entry
2169 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2170 if (menu_item_selection == i)
2171 {
2172 if (keymaps != 0)
2173 {
2174 entry = Fcons (entry, Qnil);
2175 if (!NILP (prefix))
2176 entry = Fcons (prefix, entry);
2177 }
2178 return entry;
2179 }
2180 i += MENU_ITEMS_ITEM_LENGTH;
2181 }
2182 }
2183 }
2184
2185 return Qnil;
2186}
e0f712ba 2187#endif /* HAVE_DIALOGS */
1a578e9b
AC
2188\f
2189
2190/* Is this item a separator? */
2191static int
2192name_is_separator (name)
2193 char *name;
2194{
e0f712ba
AC
2195 char *start = name;
2196
2197 /* Check if name string consists of only dashes ('-'). */
1a578e9b 2198 while (*name == '-') name++;
e0f712ba
AC
2199 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2200 or "--deep-shadow". We don't implement them yet, se we just treat
2201 them like normal separators. */
2202 return (*name == '\0' || start + 2 == name);
1a578e9b
AC
2203}
2204
2205static void
2206add_menu_item (MenuHandle menu, widget_value *wv, int submenu, int indent,
2207 int force_disable)
2208{
2209 Str255 item_name;
2210 int pos, i;
2211
2212 if (name_is_separator (wv->name))
2213 AppendMenu (menu, "\p-");
2214 else
2215 {
2216 AppendMenu (menu, "\pX");
2217
e0f712ba
AC
2218#if TARGET_API_MAC_CARBON
2219 pos = CountMenuItems (menu);
2220#else
1a578e9b 2221 pos = CountMItems (menu);
e0f712ba 2222#endif
1a578e9b
AC
2223
2224 strcpy (item_name, "");
2225 for (i = 0; i < indent; i++)
2226 strcat (item_name, " ");
2227 strcat (item_name, wv->name);
2228 if (wv->key != NULL)
2229 {
2230 strcat (item_name, " ");
2231 strcat (item_name, wv->key);
2232 }
2233 c2pstr (item_name);
2234 SetMenuItemText (menu, pos, item_name);
2235
2236 if (wv->enabled && !force_disable)
e0f712ba
AC
2237#if TARGET_API_MAC_CARBON
2238 EnableMenuItem (menu, pos);
2239#else
2240 EnableItem (menu, pos);
2241#endif
1a578e9b 2242 else
e0f712ba
AC
2243#if TARGET_API_MAC_CARBON
2244 DisableMenuItem (menu, pos);
2245#else
2246 DisableItem (menu, pos);
2247#endif
1a578e9b
AC
2248
2249 /* Draw radio buttons and tickboxes. */
2250 {
2251 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2252 wv->button_type == BUTTON_TYPE_RADIO))
2253 SetItemMark (menu, pos, checkMark);
2254 else
2255 SetItemMark (menu, pos, noMark);
2256 }
2257 }
2258
2259 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
2260
2261 if (submenu != NULL)
2262 SetMenuItemHierarchicalID (menu, pos, submenu);
2263}
2264
2265static int submenu_id;
2266
2267/* Construct native Mac OS menubar based on widget_value tree. */
2268
2269static void
2270fill_submenu (MenuHandle menu, widget_value *wv, int indent)
2271{
2272 for ( ; wv != NULL; wv = wv->next)
2273 if (wv->contents)
2274 {
2275 add_menu_item (menu, wv, NULL, indent, 1);
2276
2277 fill_submenu (menu, wv->contents, indent + 1);
2278 }
2279 else
2280 add_menu_item (menu, wv, NULL, indent, 0);
2281}
2282
2283
2284/* Construct native Mac OS menu based on widget_value tree. */
2285
2286static void
2287fill_menu (MenuHandle menu, widget_value *wv)
2288{
2289 for ( ; wv != NULL; wv = wv->next)
2290 if (wv->contents)
2291 {
2292 MenuHandle submenu = NewMenu (submenu_id, "\pX");
2293 fill_submenu (submenu, wv->contents, 0);
2294 InsertMenu (submenu, -1);
2295 add_menu_item (menu, wv, submenu_id, 0, 0);
2296 submenu_id++;
2297 }
2298 else
2299 add_menu_item (menu, wv, NULL, 0, 0);
2300}
2301
2302/* Construct native Mac OS menubar based on widget_value tree. */
2303
2304static void
2305fill_menubar (widget_value *wv)
2306{
2307 int id;
2308
2309 submenu_id = MIN_SUBMENU_ID;
2310
2311 for (id = MIN_MENU_ID; wv != NULL; wv = wv->next, id++)
2312 {
2313 MenuHandle menu;
2314 Str255 title;
2315
2316 strcpy (title, wv->name);
2317 c2pstr (title);
2318 menu = NewMenu (id, title);
2319
2320 if (wv->contents)
2321 fill_menu (menu, wv->contents);
2322
2323 InsertMenu (menu, 0);
2324 }
2325}
2326
2327#endif /* HAVE_MENUS */
e0f712ba 2328
1a578e9b
AC
2329\f
2330void
2331syms_of_macmenu ()
2332{
2333 staticpro (&menu_items);
2334 menu_items = Qnil;
2335
2336 Qdebug_on_next_call = intern ("debug-on-next-call");
2337 staticpro (&Qdebug_on_next_call);
2338
2339 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
e0f712ba
AC
2340 doc: /* Frame for which we are updating a menu.
2341The enable predicate for a menu command should check this variable. */);
1a578e9b
AC
2342 Vmenu_updating_frame = Qnil;
2343
2344 defsubr (&Sx_popup_menu);
2345#ifdef HAVE_MENUS
2346 defsubr (&Sx_popup_dialog);
2347#endif
2348}