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