Trailing whitespace deleted.
[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
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
735 xpos = (FONT_WIDTH (FRAME_FONT (f))
736 * XFASTINT (XWINDOW (window)->left));
737 ypos = (FRAME_LINE_HEIGHT (f)
738 * XFASTINT (XWINDOW (window)->top));
739 }
740 else
741 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
742 but I don't want to make one now. */
e0f712ba 743 CHECK_WINDOW (window);
1a578e9b
AC
744
745 xpos += XINT (x);
746 ypos += XINT (y);
747
748 XSETFRAME (Vmenu_updating_frame, f);
749 }
750 Vmenu_updating_frame = Qnil;
751#endif /* HAVE_MENUS */
752
753 title = Qnil;
754 GCPRO1 (title);
755
756 /* Decode the menu items from what was specified. */
757
e0f712ba
AC
758 keymap = get_keymap (menu, 0, 0);
759 if (CONSP (keymap))
1a578e9b
AC
760 {
761 /* We were given a keymap. Extract menu info from the keymap. */
762 Lisp_Object prompt;
1a578e9b
AC
763
764 /* Extract the detailed info to make one pane. */
765 keymap_panes (&menu, 1, NILP (position));
766
767 /* Search for a string appearing directly as an element of the keymap.
768 That string is the title of the menu. */
0c5b23f8 769 prompt = Fkeymap_prompt (keymap);
1a578e9b
AC
770 if (NILP (title) && !NILP (prompt))
771 title = prompt;
772
773 /* Make that be the pane title of the first pane. */
774 if (!NILP (prompt) && menu_items_n_panes >= 0)
775 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
776
777 keymaps = 1;
778 }
e0f712ba 779 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1a578e9b
AC
780 {
781 /* We were given a list of keymaps. */
782 int nmaps = XFASTINT (Flength (menu));
783 Lisp_Object *maps
784 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
785 int i;
786
787 title = Qnil;
788
789 /* The first keymap that has a prompt string
790 supplies the menu title. */
791 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
792 {
793 Lisp_Object prompt;
794
e0f712ba 795 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
1a578e9b 796
0c5b23f8 797 prompt = Fkeymap_prompt (keymap);
1a578e9b
AC
798 if (NILP (title) && !NILP (prompt))
799 title = prompt;
800 }
801
802 /* Extract the detailed info to make one pane. */
803 keymap_panes (maps, nmaps, NILP (position));
804
805 /* Make the title be the pane title of the first pane. */
806 if (!NILP (title) && menu_items_n_panes >= 0)
807 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
808
809 keymaps = 1;
810 }
811 else
812 {
813 /* We were given an old-fashioned menu. */
814 title = Fcar (menu);
e0f712ba 815 CHECK_STRING (title);
1a578e9b
AC
816
817 list_of_panes (Fcdr (menu));
818
819 keymaps = 0;
820 }
177c0ea7 821
1a578e9b
AC
822 if (NILP (position))
823 {
824 discard_menu_items ();
825 UNGCPRO;
826 return Qnil;
827 }
828
829#ifdef HAVE_MENUS
830 /* Display them in a menu. */
831 BLOCK_INPUT;
832
833 selection = mac_menu_show (f, xpos, ypos, for_click,
834 keymaps, title, &error_name);
835 UNBLOCK_INPUT;
836
837 discard_menu_items ();
838
839 UNGCPRO;
840#endif /* HAVE_MENUS */
841
842 if (error_name) error (error_name);
843 return selection;
844}
845
846#ifdef HAVE_MENUS
847
848DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
e0f712ba
AC
849 doc: /* Pop up a dialog box and return user's selection.
850POSITION specifies which frame to use.
851This is normally a mouse button event or a window or frame.
852If POSITION is t, it means to use the frame the mouse is on.
853The dialog box appears in the middle of the specified frame.
854
855CONTENTS specifies the alternatives to display in the dialog box.
856It is a list of the form (TITLE ITEM1 ITEM2...).
857Each ITEM is a cons cell (STRING . VALUE).
858The return value is VALUE from the chosen item.
859
860An ITEM may also be just a string--that makes a nonselectable item.
861An ITEM may also be nil--that means to put all preceding items
862on the left of the dialog box and all following items on the right.
863\(By default, approximately half appear on each side.) */)
1a578e9b
AC
864 (position, contents)
865 Lisp_Object position, contents;
866{
e0f712ba 867 FRAME_PTR f = NULL;
1a578e9b
AC
868 Lisp_Object window;
869
870 check_mac ();
871
872 /* Decode the first argument: find the window or frame to use. */
873 if (EQ (position, Qt)
e0f712ba
AC
874 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
875 || EQ (XCAR (position), Qtool_bar))))
1a578e9b
AC
876 {
877#if 0 /* Using the frame the mouse is on may not be right. */
878 /* Use the mouse's current position. */
879 FRAME_PTR new_f = SELECTED_FRAME ();
880 Lisp_Object bar_window;
e0f712ba 881 enum scroll_bar_part part;
1a578e9b
AC
882 unsigned long time;
883 Lisp_Object x, y;
884
885 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
886
887 if (new_f != 0)
888 XSETFRAME (window, new_f);
889 else
890 window = selected_window;
891#endif
892 window = selected_window;
893 }
894 else if (CONSP (position))
895 {
896 Lisp_Object tem;
897 tem = Fcar (position);
898 if (CONSP (tem))
899 window = Fcar (Fcdr (position));
900 else
901 {
902 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
903 window = Fcar (tem); /* POSN_WINDOW (tem) */
904 }
905 }
906 else if (WINDOWP (position) || FRAMEP (position))
907 window = position;
908 else
909 window = Qnil;
910
911 /* Decode where to put the menu. */
912
913 if (FRAMEP (window))
914 f = XFRAME (window);
915 else if (WINDOWP (window))
916 {
e0f712ba 917 CHECK_LIVE_WINDOW (window);
1a578e9b
AC
918 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
919 }
920 else
921 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
922 but I don't want to make one now. */
e0f712ba 923 CHECK_WINDOW (window);
1a578e9b
AC
924
925#ifndef HAVE_DIALOGS
926 /* Display a menu with these alternatives
927 in the middle of frame F. */
928 {
929 Lisp_Object x, y, frame, newpos;
930 XSETFRAME (frame, f);
931 XSETINT (x, x_pixel_width (f) / 2);
932 XSETINT (y, x_pixel_height (f) / 2);
933 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
934
935 return Fx_popup_menu (newpos,
936 Fcons (Fcar (contents), Fcons (contents, Qnil)));
937 }
938#else /* HAVE_DIALOGS */
939 {
940 Lisp_Object title;
941 char *error_name;
942 Lisp_Object selection;
943
944 /* Decode the dialog items from what was specified. */
945 title = Fcar (contents);
e0f712ba 946 CHECK_STRING (title);
1a578e9b
AC
947
948 list_of_panes (Fcons (contents, Qnil));
949
950 /* Display them in a dialog box. */
951 BLOCK_INPUT;
952 selection = mac_dialog_show (f, 0, title, &error_name);
953 UNBLOCK_INPUT;
954
955 discard_menu_items ();
956
957 if (error_name) error (error_name);
958 return selection;
959 }
960#endif /* HAVE_DIALOGS */
961}
962
963/* Activate the menu bar of frame F.
964 This is called from keyboard.c when it gets the
b3e8cc4d 965 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1a578e9b
AC
966
967 To activate the menu bar, we signal to the input thread that it can
968 return from the WM_INITMENU message, allowing the normal Windows
969 processing of the menus.
970
971 But first we recompute the menu bar contents (the whole tree).
972
973 This way we can safely execute Lisp code. */
177c0ea7 974
1a578e9b
AC
975void
976x_activate_menubar (f)
977 FRAME_PTR f;
978{
979 SInt32 menu_choice;
980 extern Point saved_menu_event_location;
981
982 set_frame_menubar (f, 0, 1);
983 BLOCK_INPUT;
984
985 menu_choice = MenuSelect (saved_menu_event_location);
986 do_menu_choice (menu_choice);
987
988 UNBLOCK_INPUT;
989}
990
991/* This callback is called from the menu bar pulldown menu
992 when the user makes a selection.
993 Figure out what the user chose
994 and put the appropriate events into the keyboard buffer. */
995
996void
997menubar_selection_callback (FRAME_PTR f, int client_data)
998{
999 Lisp_Object prefix, entry;
1000 Lisp_Object vector;
1001 Lisp_Object *subprefix_stack;
1002 int submenu_depth = 0;
1003 int i;
1004
1005 if (!f)
1006 return;
e0f712ba 1007 entry = Qnil;
1a578e9b
AC
1008 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1009 vector = f->menu_bar_vector;
1010 prefix = Qnil;
1011 i = 0;
1012 while (i < f->menu_bar_items_used)
1013 {
1014 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1015 {
1016 subprefix_stack[submenu_depth++] = prefix;
1017 prefix = entry;
1018 i++;
1019 }
1020 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1021 {
1022 prefix = subprefix_stack[--submenu_depth];
1023 i++;
1024 }
1025 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1026 {
1027 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1028 i += MENU_ITEMS_PANE_LENGTH;
1029 }
1030 else
1031 {
1032 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
e0f712ba
AC
1033 /* The EMACS_INT cast avoids a warning. There's no problem
1034 as long as pointers have enough bits to hold small integers. */
1035 if ((int) (EMACS_INT) client_data == i)
1a578e9b
AC
1036 {
1037 int j;
1038 struct input_event buf;
1039 Lisp_Object frame;
1040
1041 XSETFRAME (frame, f);
1042 buf.kind = MENU_BAR_EVENT;
1043 buf.frame_or_window = frame;
1044 buf.arg = frame;
1045 kbd_buffer_store_event (&buf);
1046
1047 for (j = 0; j < submenu_depth; j++)
1048 if (!NILP (subprefix_stack[j]))
1049 {
1050 buf.kind = MENU_BAR_EVENT;
1051 buf.frame_or_window = frame;
1052 buf.arg = subprefix_stack[j];
1053 kbd_buffer_store_event (&buf);
1054 }
1055
1056 if (!NILP (prefix))
1057 {
1058 buf.kind = MENU_BAR_EVENT;
1059 buf.frame_or_window = frame;
1060 buf.arg = prefix;
1061 kbd_buffer_store_event (&buf);
1062 }
1063
1064 buf.kind = MENU_BAR_EVENT;
1065 buf.frame_or_window = frame;
1066 buf.arg = entry;
1067 kbd_buffer_store_event (&buf);
1068
e0f712ba
AC
1069 f->output_data.mac->menu_command_in_progress = 0;
1070 f->output_data.mac->menubar_active = 0;
1a578e9b
AC
1071 return;
1072 }
1073 i += MENU_ITEMS_ITEM_LENGTH;
1074 }
1075 }
e0f712ba
AC
1076 f->output_data.mac->menu_command_in_progress = 0;
1077 f->output_data.mac->menubar_active = 0;
1a578e9b
AC
1078}
1079
1080/* Allocate a widget_value, blocking input. */
1081
1082widget_value *
1083xmalloc_widget_value ()
1084{
1085 widget_value *value;
1086
1087 BLOCK_INPUT;
1088 value = malloc_widget_value ();
1089 UNBLOCK_INPUT;
1090
1091 return value;
1092}
1093
1094/* This recursively calls free_widget_value on the tree of widgets.
1095 It must free all data that was malloc'ed for these widget_values.
1096 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1097 must be left alone. */
1098
1099void
1100free_menubar_widget_value_tree (wv)
1101 widget_value *wv;
1102{
1103 if (! wv) return;
1104
1105 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1106
1107 if (wv->contents && (wv->contents != (widget_value*)1))
1108 {
1109 free_menubar_widget_value_tree (wv->contents);
1110 wv->contents = (widget_value *) 0xDEADBEEF;
1111 }
1112 if (wv->next)
1113 {
1114 free_menubar_widget_value_tree (wv->next);
1115 wv->next = (widget_value *) 0xDEADBEEF;
1116 }
1117 BLOCK_INPUT;
1118 free_widget_value (wv);
1119 UNBLOCK_INPUT;
1120}
1121\f
1122/* Return a tree of widget_value structures for a menu bar item
1123 whose event type is ITEM_KEY (with string ITEM_NAME)
1124 and whose contents come from the list of keymaps MAPS. */
1125
1126static widget_value *
1127single_submenu (item_key, item_name, maps)
1128 Lisp_Object item_key, item_name, maps;
1129{
1130 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1131 int i;
1132 int submenu_depth = 0;
1133 Lisp_Object length;
1134 int len;
1135 Lisp_Object *mapvec;
1136 widget_value **submenu_stack;
1137 int previous_items = menu_items_used;
1138 int top_level_items = 0;
1139
1140 length = Flength (maps);
1141 len = XINT (length);
1142
1143 /* Convert the list MAPS into a vector MAPVEC. */
1144 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1145 for (i = 0; i < len; i++)
1146 {
1147 mapvec[i] = Fcar (maps);
1148 maps = Fcdr (maps);
1149 }
1150
1151 menu_items_n_panes = 0;
1152
1153 /* Loop over the given keymaps, making a pane for each map.
1154 But don't make a pane that is empty--ignore that map instead. */
1155 for (i = 0; i < len; i++)
1156 {
1157 if (SYMBOLP (mapvec[i])
e0f712ba 1158 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1a578e9b
AC
1159 {
1160 /* Here we have a command at top level in the menu bar
1161 as opposed to a submenu. */
1162 top_level_items = 1;
1163 push_menu_pane (Qnil, Qnil);
1164 push_menu_item (item_name, Qt, item_key, mapvec[i],
1165 Qnil, Qnil, Qnil, Qnil);
1166 }
1167 else
1168 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1169 }
1170
1171 /* Create a tree of widget_value objects
1172 representing the panes and their items. */
1173
1174 submenu_stack
1175 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1176 wv = xmalloc_widget_value ();
1177 wv->name = "menu";
1178 wv->value = 0;
1179 wv->enabled = 1;
1180 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1181 wv->help = Qnil;
1a578e9b
AC
1182 first_wv = wv;
1183 save_wv = 0;
1184 prev_wv = 0;
177c0ea7 1185
1a578e9b
AC
1186 /* Loop over all panes and items made during this call
1187 and construct a tree of widget_value objects.
1188 Ignore the panes and items made by previous calls to
1189 single_submenu, even though those are also in menu_items. */
1190 i = previous_items;
1191 while (i < menu_items_used)
1192 {
1193 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1194 {
1195 submenu_stack[submenu_depth++] = save_wv;
1196 save_wv = prev_wv;
1197 prev_wv = 0;
1198 i++;
1199 }
1200 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1201 {
1202 prev_wv = save_wv;
1203 save_wv = submenu_stack[--submenu_depth];
1204 i++;
1205 }
1206 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1207 && submenu_depth != 0)
1208 i += MENU_ITEMS_PANE_LENGTH;
1209 /* Ignore a nil in the item list.
1210 It's meaningful only for dialog boxes. */
1211 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1212 i += 1;
1213 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1214 {
1215 /* Create a new pane. */
1216 Lisp_Object pane_name, prefix;
1217 char *pane_string;
e0f712ba 1218
1a578e9b
AC
1219 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1220 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
e0f712ba 1221
1a578e9b
AC
1222#ifndef HAVE_MULTILINGUAL_MENU
1223 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
e0f712ba
AC
1224 {
1225 pane_name = ENCODE_SYSTEM (pane_name);
1226 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1227 }
1a578e9b
AC
1228#endif
1229 pane_string = (NILP (pane_name)
d5db4077 1230 ? "" : (char *) SDATA (pane_name));
1a578e9b
AC
1231 /* If there is just one top-level pane, put all its items directly
1232 under the top-level menu. */
1233 if (menu_items_n_panes == 1)
1234 pane_string = "";
1235
1236 /* If the pane has a meaningful name,
1237 make the pane a top-level menu item
1238 with its items as a submenu beneath it. */
1239 if (strcmp (pane_string, ""))
1240 {
1241 wv = xmalloc_widget_value ();
1242 if (save_wv)
1243 save_wv->next = wv;
1244 else
1245 first_wv->contents = wv;
1246 wv->name = pane_string;
1247 /* Ignore the @ that means "separate pane".
1248 This is a kludge, but this isn't worth more time. */
1249 if (!NILP (prefix) && wv->name[0] == '@')
1250 wv->name++;
1251 wv->value = 0;
1252 wv->enabled = 1;
1253 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1254 wv->help = Qnil;
1a578e9b
AC
1255 }
1256 save_wv = wv;
1257 prev_wv = 0;
1258 i += MENU_ITEMS_PANE_LENGTH;
1259 }
1260 else
1261 {
1262 /* Create a new item within current pane. */
1263 Lisp_Object item_name, enable, descrip, def, type, selected;
1264 Lisp_Object help;
1265
e0f712ba
AC
1266 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1267 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1268 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1269 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1270 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1271 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1272 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1a578e9b
AC
1273
1274#ifndef HAVE_MULTILINGUAL_MENU
e0f712ba
AC
1275 if (STRING_MULTIBYTE (item_name))
1276 {
1277 item_name = ENCODE_SYSTEM (item_name);
1278 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1279 }
1280
1281 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1282 {
1283 descrip = ENCODE_SYSTEM (descrip);
1284 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1285 }
1286#endif /* not HAVE_MULTILINGUAL_MENU */
1a578e9b
AC
1287
1288 wv = xmalloc_widget_value ();
177c0ea7 1289 if (prev_wv)
1a578e9b
AC
1290 prev_wv->next = wv;
1291 else
1292 save_wv->contents = wv;
1293
d5db4077 1294 wv->name = (char *) SDATA (item_name);
1a578e9b 1295 if (!NILP (descrip))
d5db4077 1296 wv->key = (char *) SDATA (descrip);
1a578e9b
AC
1297 wv->value = 0;
1298 /* The EMACS_INT cast avoids a warning. There's no problem
1299 as long as pointers have enough bits to hold small integers. */
1300 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1301 wv->enabled = !NILP (enable);
1302
1303 if (NILP (type))
1304 wv->button_type = BUTTON_TYPE_NONE;
1305 else if (EQ (type, QCradio))
1306 wv->button_type = BUTTON_TYPE_RADIO;
1307 else if (EQ (type, QCtoggle))
1308 wv->button_type = BUTTON_TYPE_TOGGLE;
1309 else
1310 abort ();
1311
1312 wv->selected = !NILP (selected);
e0f712ba
AC
1313 if (!STRINGP (help))
1314 help = Qnil;
1315
1316 wv->help = help;
1a578e9b
AC
1317
1318 prev_wv = wv;
1319
1320 i += MENU_ITEMS_ITEM_LENGTH;
1321 }
1322 }
1323
1324 /* If we have just one "menu item"
1325 that was originally a button, return it by itself. */
1326 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1327 {
1328 wv = first_wv->contents;
1329 free_widget_value (first_wv);
1330 return wv;
1331 }
1332
1333 return first_wv;
1334}
1335\f
1336/* Set the contents of the menubar widgets of frame F.
1337 The argument FIRST_TIME is currently ignored;
1338 it is set the first time this is called, from initialize_frame_menubar. */
1339
1340void
1341set_frame_menubar (f, first_time, deep_p)
1342 FRAME_PTR f;
1343 int first_time;
1344 int deep_p;
1345{
1346 int menubar_widget = f->output_data.mac->menubar_widget;
1347 Lisp_Object items;
1348 widget_value *wv, *first_wv, *prev_wv = 0;
1349 int i;
1350
e0f712ba
AC
1351 /* We must not change the menubar when actually in use. */
1352 if (f->output_data.mac->menubar_active)
1353 return;
1354
1a578e9b
AC
1355 XSETFRAME (Vmenu_updating_frame, f);
1356
e0f712ba
AC
1357 if (! menubar_widget)
1358 deep_p = 1;
1359 else if (pending_menu_activation && !deep_p)
1360 deep_p = 1;
1361
1a578e9b
AC
1362 wv = xmalloc_widget_value ();
1363 wv->name = "menubar";
1364 wv->value = 0;
1365 wv->enabled = 1;
1366 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1367 wv->help = Qnil;
1a578e9b
AC
1368 first_wv = wv;
1369
e0f712ba
AC
1370 if (deep_p)
1371 {
1372 /* Make a widget-value tree representing the entire menu trees. */
1373
1374 struct buffer *prev = current_buffer;
1375 Lisp_Object buffer;
aed13378 1376 int specpdl_count = SPECPDL_INDEX ();
e0f712ba
AC
1377 int previous_menu_items_used = f->menu_bar_items_used;
1378 Lisp_Object *previous_items
1379 = (Lisp_Object *) alloca (previous_menu_items_used
1380 * sizeof (Lisp_Object));
1381
1382 /* If we are making a new widget, its contents are empty,
1383 do always reinitialize them. */
1384 if (! menubar_widget)
1385 previous_menu_items_used = 0;
1386
1387 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1388 specbind (Qinhibit_quit, Qt);
1389 /* Don't let the debugger step into this code
1390 because it is not reentrant. */
1391 specbind (Qdebug_on_next_call, Qnil);
1392
1393 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1394 if (NILP (Voverriding_local_map_menu_flag))
1395 {
1396 specbind (Qoverriding_terminal_local_map, Qnil);
1397 specbind (Qoverriding_local_map, Qnil);
1398 }
1a578e9b 1399
e0f712ba 1400 set_buffer_internal_1 (XBUFFER (buffer));
1a578e9b 1401
e0f712ba
AC
1402 /* Run the Lucid hook. */
1403 safe_run_hooks (Qactivate_menubar_hook);
1404 /* If it has changed current-menubar from previous value,
1405 really recompute the menubar from the value. */
1406 if (! NILP (Vlucid_menu_bar_dirty_flag))
1407 call0 (Qrecompute_lucid_menubar);
1408 safe_run_hooks (Qmenu_bar_update_hook);
1409 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1a578e9b 1410
e0f712ba 1411 items = FRAME_MENU_BAR_ITEMS (f);
1a578e9b 1412
e0f712ba 1413 inhibit_garbage_collection ();
1a578e9b 1414
e0f712ba
AC
1415 /* Save the frame's previous menu bar contents data. */
1416 if (previous_menu_items_used)
1417 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1418 previous_menu_items_used * sizeof (Lisp_Object));
1a578e9b 1419
e0f712ba
AC
1420 /* Fill in the current menu bar contents. */
1421 menu_items = f->menu_bar_vector;
1422 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1423 init_menu_items ();
1424 for (i = 0; i < XVECTOR (items)->size; i += 4)
1425 {
1426 Lisp_Object key, string, maps;
1427
1428 key = XVECTOR (items)->contents[i];
1429 string = XVECTOR (items)->contents[i + 1];
1430 maps = XVECTOR (items)->contents[i + 2];
1431 if (NILP (string))
1432 break;
1433
1434 wv = single_submenu (key, string, maps);
177c0ea7 1435 if (prev_wv)
e0f712ba
AC
1436 prev_wv->next = wv;
1437 else
1438 first_wv->contents = wv;
1439 /* Don't set wv->name here; GC during the loop might relocate it. */
1440 wv->enabled = 1;
1441 wv->button_type = BUTTON_TYPE_NONE;
1442 prev_wv = wv;
1443 }
1444
1445 finish_menu_items ();
1a578e9b 1446
e0f712ba
AC
1447 set_buffer_internal_1 (prev);
1448 unbind_to (specpdl_count, Qnil);
1449
1450 /* If there has been no change in the Lisp-level contents
1451 of the menu bar, skip redisplaying it. Just exit. */
1452
1453 for (i = 0; i < previous_menu_items_used; i++)
1454 if (menu_items_used == i
1455 || (!Fequal (previous_items[i], XVECTOR (menu_items)->contents[i])))
1a578e9b 1456 break;
e0f712ba
AC
1457 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1458 {
1459 free_menubar_widget_value_tree (first_wv);
1460 menu_items = Qnil;
1a578e9b 1461
e0f712ba
AC
1462 return;
1463 }
1a578e9b 1464
e0f712ba
AC
1465 /* Now GC cannot happen during the lifetime of the widget_value,
1466 so it's safe to store data from a Lisp_String, as long as
1467 local copies are made when the actual menu is created.
1468 Windows takes care of this for normal string items, but
1469 not for owner-drawn items or additional item-info. */
1470 wv = first_wv->contents;
1471 for (i = 0; i < XVECTOR (items)->size; i += 4)
1472 {
1473 Lisp_Object string;
1474 string = XVECTOR (items)->contents[i + 1];
1475 if (NILP (string))
1476 break;
d5db4077 1477 wv->name = (char *) SDATA (string);
e0f712ba
AC
1478 wv = wv->next;
1479 }
1a578e9b 1480
e0f712ba
AC
1481 f->menu_bar_vector = menu_items;
1482 f->menu_bar_items_used = menu_items_used;
1483 menu_items = Qnil;
1484 }
1485 else
1486 {
1487 /* Make a widget-value tree containing
1488 just the top level menu bar strings. */
1a578e9b 1489
e0f712ba
AC
1490 items = FRAME_MENU_BAR_ITEMS (f);
1491 for (i = 0; i < XVECTOR (items)->size; i += 4)
1492 {
1493 Lisp_Object string;
1a578e9b 1494
e0f712ba
AC
1495 string = XVECTOR (items)->contents[i + 1];
1496 if (NILP (string))
1497 break;
1a578e9b 1498
e0f712ba 1499 wv = xmalloc_widget_value ();
d5db4077 1500 wv->name = (char *) SDATA (string);
e0f712ba
AC
1501 wv->value = 0;
1502 wv->enabled = 1;
1503 wv->button_type = BUTTON_TYPE_NONE;
1504 wv->help = Qnil;
1505 /* This prevents lwlib from assuming this
1506 menu item is really supposed to be empty. */
1507 /* The EMACS_INT cast avoids a warning.
1508 This value just has to be different from small integers. */
1509 wv->call_data = (void *) (EMACS_INT) (-1);
1a578e9b 1510
177c0ea7 1511 if (prev_wv)
e0f712ba
AC
1512 prev_wv->next = wv;
1513 else
1514 first_wv->contents = wv;
1515 prev_wv = wv;
1516 }
1a578e9b 1517
e0f712ba
AC
1518 /* Forget what we thought we knew about what is in the
1519 detailed contents of the menu bar menus.
1520 Changing the top level always destroys the contents. */
1521 f->menu_bar_items_used = 0;
1522 }
1a578e9b
AC
1523
1524 /* Create or update the menu bar widget. */
1525
1526 BLOCK_INPUT;
1527
e0f712ba
AC
1528 /* Non-null value to indicate menubar has already been "created". */
1529 f->output_data.mac->menubar_widget = 1;
1a578e9b
AC
1530
1531 {
1532 int i = MIN_MENU_ID;
1533 MenuHandle menu = GetMenuHandle (i);
1534 while (menu != NULL)
1535 {
e0f712ba
AC
1536 DeleteMenu (i);
1537 DisposeMenu (menu);
1538 menu = GetMenuHandle (++i);
1a578e9b 1539 }
177c0ea7 1540
1a578e9b
AC
1541 i = MIN_SUBMENU_ID;
1542 menu = GetMenuHandle (i);
1543 while (menu != NULL)
1544 {
e0f712ba
AC
1545 DeleteMenu (i);
1546 DisposeMenu (menu);
1547 menu = GetMenuHandle (++i);
1a578e9b
AC
1548 }
1549 }
1550
1551 fill_menubar (first_wv->contents);
177c0ea7 1552
1a578e9b 1553 DrawMenuBar ();
177c0ea7 1554
1a578e9b
AC
1555 free_menubar_widget_value_tree (first_wv);
1556
1557 UNBLOCK_INPUT;
1558}
1559
e0f712ba
AC
1560/* Called from Fx_create_frame to create the initial menubar of a frame
1561 before it is mapped, so that the window is mapped with the menubar already
1562 there instead of us tacking it on later and thrashing the window after it
1563 is visible. */
1a578e9b
AC
1564
1565void
1566initialize_frame_menubar (f)
1567 FRAME_PTR f;
1568{
1569 /* This function is called before the first chance to redisplay
1570 the frame. It has to be, so the frame will have the right size. */
1571 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1572 set_frame_menubar (f, 1, 1);
1573}
1574
1575/* Get rid of the menu bar of frame F, and free its storage.
1576 This is used when deleting a frame, and when turning off the menu bar. */
1577
1578void
1579free_frame_menubar (f)
1580 FRAME_PTR f;
1581{
e0f712ba 1582 f->output_data.mac->menubar_widget = NULL;
1a578e9b
AC
1583}
1584
1585\f
1586/* mac_menu_show actually displays a menu using the panes and items in
1587 menu_items and returns the value selected from it; we assume input
1588 is blocked by the caller. */
1589
1590/* F is the frame the menu is for.
1591 X and Y are the frame-relative specified position,
1592 relative to the inside upper left corner of the frame F.
1593 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1594 KEYMAPS is 1 if this menu was specified with keymaps;
1595 in that case, we return a list containing the chosen item's value
1596 and perhaps also the pane's prefix.
1597 TITLE is the specified menu title.
1598 ERROR is a place to store an error message string in case of failure.
1599 (We return nil on failure, but the value doesn't actually matter.) */
1600
1601static Lisp_Object
1602mac_menu_show (f, x, y, for_click, keymaps, title, error)
1603 FRAME_PTR f;
1604 int x;
1605 int y;
1606 int for_click;
1607 int keymaps;
1608 Lisp_Object title;
1609 char **error;
1610{
1611 int i;
61f1d295
ST
1612 UInt32 refcon;
1613 int menu_item_choice;
1a578e9b
AC
1614 int menu_item_selection;
1615 MenuHandle menu;
1616 Point pos;
1617 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1618 widget_value **submenu_stack
1619 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1620 Lisp_Object *subprefix_stack
1621 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1622 int submenu_depth = 0;
1623 int first_pane;
1a578e9b
AC
1624
1625 *error = NULL;
1626
1627 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1628 {
1629 *error = "Empty menu";
1630 return Qnil;
1631 }
1632
1633 /* Create a tree of widget_value objects
1634 representing the panes and their items. */
1635 wv = xmalloc_widget_value ();
1636 wv->name = "menu";
1637 wv->value = 0;
1638 wv->enabled = 1;
1639 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1640 wv->help = Qnil;
1a578e9b
AC
1641 first_wv = wv;
1642 first_pane = 1;
177c0ea7 1643
1a578e9b
AC
1644 /* Loop over all panes and items, filling in the tree. */
1645 i = 0;
1646 while (i < menu_items_used)
1647 {
1648 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1649 {
1650 submenu_stack[submenu_depth++] = save_wv;
1651 save_wv = prev_wv;
1652 prev_wv = 0;
1653 first_pane = 1;
1654 i++;
1655 }
1656 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1657 {
1658 prev_wv = save_wv;
1659 save_wv = submenu_stack[--submenu_depth];
1660 first_pane = 0;
1661 i++;
1662 }
1663 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1664 && submenu_depth != 0)
1665 i += MENU_ITEMS_PANE_LENGTH;
1666 /* Ignore a nil in the item list.
1667 It's meaningful only for dialog boxes. */
1668 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1669 i += 1;
1670 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1671 {
1672 /* Create a new pane. */
1673 Lisp_Object pane_name, prefix;
1674 char *pane_string;
e0f712ba
AC
1675 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1676 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1a578e9b
AC
1677#ifndef HAVE_MULTILINGUAL_MENU
1678 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
e0f712ba
AC
1679 {
1680 pane_name = ENCODE_SYSTEM (pane_name);
1681 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1682 }
1a578e9b
AC
1683#endif
1684 pane_string = (NILP (pane_name)
d5db4077 1685 ? "" : (char *) SDATA (pane_name));
1a578e9b
AC
1686 /* If there is just one top-level pane, put all its items directly
1687 under the top-level menu. */
1688 if (menu_items_n_panes == 1)
1689 pane_string = "";
1690
1691 /* If the pane has a meaningful name,
1692 make the pane a top-level menu item
1693 with its items as a submenu beneath it. */
1694 if (!keymaps && strcmp (pane_string, ""))
1695 {
1696 wv = xmalloc_widget_value ();
1697 if (save_wv)
1698 save_wv->next = wv;
1699 else
1700 first_wv->contents = wv;
1701 wv->name = pane_string;
1702 if (keymaps && !NILP (prefix))
1703 wv->name++;
1704 wv->value = 0;
1705 wv->enabled = 1;
1706 wv->button_type = BUTTON_TYPE_NONE;
e0f712ba 1707 wv->help = Qnil;
1a578e9b
AC
1708 save_wv = wv;
1709 prev_wv = 0;
1710 }
1711 else if (first_pane)
1712 {
1713 save_wv = wv;
1714 prev_wv = 0;
1715 }
1716 first_pane = 0;
1717 i += MENU_ITEMS_PANE_LENGTH;
1718 }
1719 else
1720 {
1721 /* Create a new item within current pane. */
1722 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1723
e0f712ba
AC
1724 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1725 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1726 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1727 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1728 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1729 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1730 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1a578e9b
AC
1731
1732#ifndef HAVE_MULTILINGUAL_MENU
e0f712ba
AC
1733 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1734 {
1735 item_name = ENCODE_SYSTEM (item_name);
1736 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1737 }
1a578e9b 1738 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
e0f712ba
AC
1739 {
1740 descrip = ENCODE_SYSTEM (descrip);
1741 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1742 }
1743#endif /* not HAVE_MULTILINGUAL_MENU */
1a578e9b
AC
1744
1745 wv = xmalloc_widget_value ();
177c0ea7 1746 if (prev_wv)
1a578e9b 1747 prev_wv->next = wv;
177c0ea7 1748 else
1a578e9b 1749 save_wv->contents = wv;
d5db4077 1750 wv->name = (char *) SDATA (item_name);
1a578e9b 1751 if (!NILP (descrip))
d5db4077 1752 wv->key = (char *) SDATA (descrip);
1a578e9b
AC
1753 wv->value = 0;
1754 /* Use the contents index as call_data, since we are
e0f712ba 1755 restricted to 16-bits. */
1a578e9b
AC
1756 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1757 wv->enabled = !NILP (enable);
1758
1759 if (NILP (type))
1760 wv->button_type = BUTTON_TYPE_NONE;
1761 else if (EQ (type, QCtoggle))
1762 wv->button_type = BUTTON_TYPE_TOGGLE;
1763 else if (EQ (type, QCradio))
1764 wv->button_type = BUTTON_TYPE_RADIO;
1765 else
1766 abort ();
1767
1768 wv->selected = !NILP (selected);
e0f712ba
AC
1769 if (!STRINGP (help))
1770 help = Qnil;
1a578e9b 1771
e0f712ba 1772 wv->help = help;
1a578e9b
AC
1773
1774 prev_wv = wv;
1775
1776 i += MENU_ITEMS_ITEM_LENGTH;
1777 }
1778 }
1779
1780 /* Deal with the title, if it is non-nil. */
1781 if (!NILP (title))
1782 {
1783 widget_value *wv_title = xmalloc_widget_value ();
1784 widget_value *wv_sep = xmalloc_widget_value ();
1785
1786 /* Maybe replace this separator with a bitmap or owner-draw item
1787 so that it looks better. Having two separators looks odd. */
1788 wv_sep->name = "--";
1789 wv_sep->next = first_wv->contents;
e0f712ba 1790 wv_sep->help = Qnil;
1a578e9b
AC
1791
1792#ifndef HAVE_MULTILINGUAL_MENU
1793 if (STRING_MULTIBYTE (title))
e0f712ba 1794 title = ENCODE_SYSTEM (title);
1a578e9b 1795#endif
d5db4077 1796 wv_title->name = (char *) SDATA (title);
e0f712ba
AC
1797 wv_title->enabled = TRUE;
1798 wv_title->title = TRUE;
1a578e9b 1799 wv_title->button_type = BUTTON_TYPE_NONE;
e0f712ba 1800 wv_title->help = Qnil;
1a578e9b
AC
1801 wv_title->next = wv_sep;
1802 first_wv->contents = wv_title;
1803 }
1804
1805 /* Actually create the menu. */
1806 menu = NewMenu (POPUP_SUBMENU_ID, "\p");
61f1d295
ST
1807 submenu_id = MIN_POPUP_SUBMENU_ID;
1808 fill_submenu (menu, first_wv->contents);
1a578e9b
AC
1809
1810 /* Adjust coordinates to be root-window-relative. */
1811 pos.h = x;
1812 pos.v = y;
e0f712ba
AC
1813
1814#if TARGET_API_MAC_CARBON
1815 SetPort (GetWindowPort (FRAME_MAC_WINDOW (f)));
1816#else
1a578e9b 1817 SetPort (FRAME_MAC_WINDOW (f));
e0f712ba
AC
1818#endif
1819
1a578e9b
AC
1820 LocalToGlobal (&pos);
1821
e0f712ba 1822 /* No selection has been chosen yet. */
61f1d295 1823 menu_item_choice = 0;
e0f712ba
AC
1824 menu_item_selection = 0;
1825
1a578e9b
AC
1826 InsertMenu (menu, -1);
1827
1828 /* Display the menu. */
61f1d295
ST
1829 menu_item_choice = PopUpMenuSelect (menu, pos.v, pos.h, 0);
1830 menu_item_selection = LoWord (menu_item_choice);
1a578e9b 1831
61f1d295 1832 /* Get the refcon to find the correct item*/
177c0ea7 1833 if (menu_item_selection)
61f1d295
ST
1834 {
1835 menu = GetMenuHandle (HiWord (menu_item_choice));
1836 if (menu) {
1837 GetMenuItemRefCon (menu, menu_item_selection, &refcon);
1838 }
1839 }
177c0ea7 1840
1a578e9b
AC
1841#if 0
1842 /* Clean up extraneous mouse events which might have been generated
1843 during the call. */
1844 discard_mouse_events ();
1845#endif
1846
1847 /* Free the widget_value objects we used to specify the
1848 contents. */
1849 free_menubar_widget_value_tree (first_wv);
1850
61f1d295
ST
1851 /* delete all menus */
1852 {
1853 int i = MIN_POPUP_SUBMENU_ID;
1854 MenuHandle submenu = GetMenuHandle (i);
1855 while (menu != NULL)
1856 {
1857 DeleteMenu (i);
1858 DisposeMenu (menu);
1859 menu = GetMenuHandle (++i);
1860 }
1861 }
1862
1863 DeleteMenu (POPUP_SUBMENU_ID);
1a578e9b
AC
1864 DisposeMenu (menu);
1865
e0f712ba
AC
1866 /* Find the selected item, and its pane, to return
1867 the proper value. */
1a578e9b
AC
1868 if (menu_item_selection != 0)
1869 {
1870 Lisp_Object prefix, entry;
1871
e0f712ba 1872 prefix = entry = Qnil;
1a578e9b
AC
1873 i = 0;
1874 while (i < menu_items_used)
1875 {
1876 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1877 {
1878 subprefix_stack[submenu_depth++] = prefix;
1879 prefix = entry;
1880 i++;
1881 }
1882 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1883 {
1884 prefix = subprefix_stack[--submenu_depth];
1885 i++;
1886 }
1887 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1888 {
1889 prefix
1890 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1891 i += MENU_ITEMS_PANE_LENGTH;
1892 }
e0f712ba
AC
1893 /* Ignore a nil in the item list.
1894 It's meaningful only for dialog boxes. */
1a578e9b
AC
1895 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1896 i += 1;
1897 else
1898 {
1899 entry
1900 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
61f1d295 1901 if ((int) (EMACS_INT) refcon == i)
1a578e9b
AC
1902 {
1903 if (keymaps != 0)
1904 {
1905 int j;
1906
1907 entry = Fcons (entry, Qnil);
1908 if (!NILP (prefix))
1909 entry = Fcons (prefix, entry);
1910 for (j = submenu_depth - 1; j >= 0; j--)
1911 if (!NILP (subprefix_stack[j]))
1912 entry = Fcons (subprefix_stack[j], entry);
1913 }
1914 return entry;
1915 }
1916 i += MENU_ITEMS_ITEM_LENGTH;
1917 }
1918 }
1919 }
1920
1921 return Qnil;
1922}
1923\f
1924
e0f712ba 1925#ifdef HAVE_DIALOGS
1a578e9b
AC
1926/* Construct native Mac OS menubar based on widget_value tree. */
1927
1928static int
1929mac_dialog (widget_value *wv)
1930{
1931 char *dialog_name;
1932 char *prompt;
1933 char **button_labels;
1934 UInt32 *ref_cons;
1935 int nb_buttons;
1936 int left_count;
1937 int i;
1938 int dialog_width;
1939 Rect rect;
1940 WindowPtr window_ptr;
1941 ControlHandle ch;
1942 int left;
1943 EventRecord event_record;
1944 SInt16 part_code;
1945 int control_part_code;
1946 Point mouse;
177c0ea7 1947
1a578e9b
AC
1948 dialog_name = wv->name;
1949 nb_buttons = dialog_name[1] - '0';
1950 left_count = nb_buttons - (dialog_name[4] - '0');
1951 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
e0f712ba 1952 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
177c0ea7 1953
1a578e9b
AC
1954 wv = wv->contents;
1955 prompt = (char *) alloca (strlen (wv->value) + 1);
1956 strcpy (prompt, wv->value);
1957 c2pstr (prompt);
1958
1959 wv = wv->next;
1960 for (i = 0; i < nb_buttons; i++)
1961 {
1962 button_labels[i] = wv->value;
1963 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
1964 strcpy (button_labels[i], wv->value);
1965 c2pstr (button_labels[i]);
1966 ref_cons[i] = (UInt32) wv->call_data;
1967 wv = wv->next;
1968 }
1969
1970 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
e0f712ba
AC
1971
1972#if TARGET_API_MAC_CARBON
1973 SetPort (GetWindowPort (window_ptr));
1974#else
1a578e9b 1975 SetPort (window_ptr);
e0f712ba 1976#endif
177c0ea7 1977
1a578e9b
AC
1978 TextFont (0);
1979 /* Left and right margins in the dialog are 13 pixels each.*/
1980 dialog_width = 14;
1981 /* Calculate width of dialog box: 8 pixels on each side of the text
1982 label in each button, 12 pixels between buttons. */
1983 for (i = 0; i < nb_buttons; i++)
1984 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
1985
1986 if (left_count != 0 && nb_buttons - left_count != 0)
1987 dialog_width += 12;
1988
1989 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
1990
1991 SizeWindow (window_ptr, dialog_width, 78, 0);
1992 ShowWindow (window_ptr);
1993
e0f712ba
AC
1994#if TARGET_API_MAC_CARBON
1995 SetPort (GetWindowPort (window_ptr));
1996#else
1a578e9b 1997 SetPort (window_ptr);
e0f712ba 1998#endif
177c0ea7 1999
1a578e9b
AC
2000 TextFont (0);
2001
2002 MoveTo (13, 29);
2003 DrawString (prompt);
2004
2005 left = 13;
2006 for (i = 0; i < nb_buttons; i++)
2007 {
2008 int button_width = StringWidth (button_labels[i]) + 16;
2009 SetRect (&rect, left, 45, left + button_width, 65);
2010 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2011 kControlPushButtonProc, ref_cons[i]);
2012 left += button_width + 12;
2013 if (i == left_count - 1)
2014 left += 12;
2015 }
2016
2017 i = 0;
2018 while (!i)
2019 {
2020 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2021 if (event_record.what == mouseDown)
2022 {
2023 part_code = FindWindow (event_record.where, &window_ptr);
2024 if (part_code == inContent)
2025 {
2026 mouse = event_record.where;
2027 GlobalToLocal (&mouse);
2028 control_part_code = FindControl (mouse, window_ptr, &ch);
2029 if (control_part_code == kControlButtonPart)
2030 if (TrackControl (ch, mouse, NULL))
2031 i = GetControlReference (ch);
2032 }
2033 }
2034 }
2035
2036 DisposeWindow (window_ptr);
177c0ea7 2037
1a578e9b
AC
2038 return i;
2039}
2040
2041static char * button_names [] = {
2042 "button1", "button2", "button3", "button4", "button5",
2043 "button6", "button7", "button8", "button9", "button10" };
2044
2045static Lisp_Object
2046mac_dialog_show (f, keymaps, title, error)
2047 FRAME_PTR f;
2048 int keymaps;
2049 Lisp_Object title;
2050 char **error;
2051{
2052 int i, nb_buttons=0;
2053 char dialog_name[6];
2054 int menu_item_selection;
2055
e0f712ba 2056 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1a578e9b
AC
2057
2058 /* Number of elements seen so far, before boundary. */
2059 int left_count = 0;
e0f712ba 2060 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1a578e9b
AC
2061 int boundary_seen = 0;
2062
2063 *error = NULL;
2064
2065 if (menu_items_n_panes > 1)
2066 {
2067 *error = "Multiple panes in dialog box";
2068 return Qnil;
2069 }
2070
e0f712ba
AC
2071 /* Create a tree of widget_value objects
2072 representing the text label and buttons. */
1a578e9b
AC
2073 {
2074 Lisp_Object pane_name, prefix;
2075 char *pane_string;
2076 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2077 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2078 pane_string = (NILP (pane_name)
177c0ea7 2079 ? "" : (char *) SDATA (pane_name));
1a578e9b
AC
2080 prev_wv = xmalloc_widget_value ();
2081 prev_wv->value = pane_string;
2082 if (keymaps && !NILP (prefix))
2083 prev_wv->name++;
2084 prev_wv->enabled = 1;
2085 prev_wv->name = "message";
e0f712ba 2086 prev_wv->help = Qnil;
1a578e9b 2087 first_wv = prev_wv;
177c0ea7 2088
1a578e9b
AC
2089 /* Loop over all panes and items, filling in the tree. */
2090 i = MENU_ITEMS_PANE_LENGTH;
2091 while (i < menu_items_used)
2092 {
177c0ea7 2093
1a578e9b
AC
2094 /* Create a new item within current pane. */
2095 Lisp_Object item_name, enable, descrip, help;
2096
2097 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2098 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2099 descrip
2100 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2101 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
177c0ea7 2102
1a578e9b
AC
2103 if (NILP (item_name))
2104 {
2105 free_menubar_widget_value_tree (first_wv);
2106 *error = "Submenu in dialog items";
2107 return Qnil;
2108 }
2109 if (EQ (item_name, Qquote))
2110 {
e0f712ba
AC
2111 /* This is the boundary between left-side elts
2112 and right-side elts. Stop incrementing right_count. */
1a578e9b
AC
2113 boundary_seen = 1;
2114 i++;
2115 continue;
2116 }
2117 if (nb_buttons >= 9)
2118 {
2119 free_menubar_widget_value_tree (first_wv);
2120 *error = "Too many dialog items";
2121 return Qnil;
2122 }
2123
2124 wv = xmalloc_widget_value ();
2125 prev_wv->next = wv;
2126 wv->name = (char *) button_names[nb_buttons];
2127 if (!NILP (descrip))
d5db4077
KR
2128 wv->key = (char *) SDATA (descrip);
2129 wv->value = (char *) SDATA (item_name);
1a578e9b
AC
2130 wv->call_data = (void *) i;
2131 /* menu item is identified by its index in menu_items table */
2132 wv->enabled = !NILP (enable);
e0f712ba 2133 wv->help = Qnil;
1a578e9b
AC
2134 prev_wv = wv;
2135
2136 if (! boundary_seen)
2137 left_count++;
2138
2139 nb_buttons++;
2140 i += MENU_ITEMS_ITEM_LENGTH;
2141 }
2142
e0f712ba
AC
2143 /* If the boundary was not specified,
2144 by default put half on the left and half on the right. */
1a578e9b
AC
2145 if (! boundary_seen)
2146 left_count = nb_buttons - nb_buttons / 2;
2147
2148 wv = xmalloc_widget_value ();
2149 wv->name = dialog_name;
e0f712ba 2150 wv->help = Qnil;
1a578e9b 2151
e0f712ba
AC
2152 /* Dialog boxes use a really stupid name encoding
2153 which specifies how many buttons to use
2154 and how many buttons are on the right.
1a578e9b
AC
2155 The Q means something also. */
2156 dialog_name[0] = 'Q';
2157 dialog_name[1] = '0' + nb_buttons;
2158 dialog_name[2] = 'B';
2159 dialog_name[3] = 'R';
2160 /* Number of buttons to put on the right. */
2161 dialog_name[4] = '0' + nb_buttons - left_count;
2162 dialog_name[5] = 0;
2163 wv->contents = first_wv;
2164 first_wv = wv;
2165 }
2166
2167 /* Actually create the dialog. */
2168#ifdef HAVE_DIALOGS
2169 menu_item_selection = mac_dialog (first_wv);
2170#else
2171 menu_item_selection = 0;
2172#endif
2173
e0f712ba 2174 /* Free the widget_value objects we used to specify the contents. */
1a578e9b
AC
2175 free_menubar_widget_value_tree (first_wv);
2176
2177 /* Find the selected item, and its pane, to return the proper
2178 value. */
2179 if (menu_item_selection != 0)
2180 {
2181 Lisp_Object prefix;
2182
2183 prefix = Qnil;
2184 i = 0;
2185 while (i < menu_items_used)
2186 {
2187 Lisp_Object entry;
2188
2189 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2190 {
2191 prefix
2192 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2193 i += MENU_ITEMS_PANE_LENGTH;
2194 }
2195 else
2196 {
2197 entry
2198 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2199 if (menu_item_selection == i)
2200 {
2201 if (keymaps != 0)
2202 {
2203 entry = Fcons (entry, Qnil);
2204 if (!NILP (prefix))
2205 entry = Fcons (prefix, entry);
2206 }
2207 return entry;
2208 }
2209 i += MENU_ITEMS_ITEM_LENGTH;
2210 }
2211 }
2212 }
2213
2214 return Qnil;
2215}
e0f712ba 2216#endif /* HAVE_DIALOGS */
1a578e9b
AC
2217\f
2218
2219/* Is this item a separator? */
2220static int
2221name_is_separator (name)
2222 char *name;
2223{
e0f712ba
AC
2224 char *start = name;
2225
2226 /* Check if name string consists of only dashes ('-'). */
1a578e9b 2227 while (*name == '-') name++;
e0f712ba
AC
2228 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2229 or "--deep-shadow". We don't implement them yet, se we just treat
2230 them like normal separators. */
2231 return (*name == '\0' || start + 2 == name);
1a578e9b
AC
2232}
2233
2234static void
61f1d295 2235add_menu_item (MenuHandle menu, widget_value *wv, int submenu,
1a578e9b
AC
2236 int force_disable)
2237{
2238 Str255 item_name;
2239 int pos, i;
2240
2241 if (name_is_separator (wv->name))
2242 AppendMenu (menu, "\p-");
177c0ea7 2243 else
1a578e9b
AC
2244 {
2245 AppendMenu (menu, "\pX");
177c0ea7 2246
e0f712ba
AC
2247#if TARGET_API_MAC_CARBON
2248 pos = CountMenuItems (menu);
2249#else
1a578e9b 2250 pos = CountMItems (menu);
e0f712ba 2251#endif
1a578e9b
AC
2252
2253 strcpy (item_name, "");
72742a99 2254 strncat (item_name, wv->name, 255);
1a578e9b
AC
2255 if (wv->key != NULL)
2256 {
72742a99
AC
2257 strncat (item_name, " ", 255);
2258 strncat (item_name, wv->key, 255);
1a578e9b 2259 }
72742a99 2260 item_name[255] = 0;
1a578e9b
AC
2261 c2pstr (item_name);
2262 SetMenuItemText (menu, pos, item_name);
2263
2264 if (wv->enabled && !force_disable)
e0f712ba
AC
2265#if TARGET_API_MAC_CARBON
2266 EnableMenuItem (menu, pos);
2267#else
2268 EnableItem (menu, pos);
2269#endif
1a578e9b 2270 else
e0f712ba
AC
2271#if TARGET_API_MAC_CARBON
2272 DisableMenuItem (menu, pos);
2273#else
2274 DisableItem (menu, pos);
2275#endif
1a578e9b
AC
2276
2277 /* Draw radio buttons and tickboxes. */
2278 {
2279 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2280 wv->button_type == BUTTON_TYPE_RADIO))
2281 SetItemMark (menu, pos, checkMark);
2282 else
2283 SetItemMark (menu, pos, noMark);
2284 }
2285 }
2286
2287 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
2288
2289 if (submenu != NULL)
2290 SetMenuItemHierarchicalID (menu, pos, submenu);
2291}
2292
1a578e9b
AC
2293/* Construct native Mac OS menubar based on widget_value tree. */
2294
2295static void
61f1d295 2296fill_submenu (MenuHandle menu, widget_value *wv)
1a578e9b
AC
2297{
2298 for ( ; wv != NULL; wv = wv->next)
2299 if (wv->contents)
2300 {
61f1d295
ST
2301 int cur_submenu = submenu_id++;
2302 MenuHandle submenu = NewMenu (cur_submenu, "\pX");
2303 fill_submenu (submenu, wv->contents);
2304 InsertMenu (submenu, -1);
2305 add_menu_item (menu, wv, cur_submenu, 0);
1a578e9b
AC
2306 }
2307 else
61f1d295 2308 add_menu_item (menu, wv, NULL, 0);
1a578e9b
AC
2309}
2310
2311
2312/* Construct native Mac OS menu based on widget_value tree. */
2313
2314static void
2315fill_menu (MenuHandle menu, widget_value *wv)
2316{
2317 for ( ; wv != NULL; wv = wv->next)
2318 if (wv->contents)
2319 {
61f1d295
ST
2320 int cur_submenu = submenu_id++;
2321 MenuHandle submenu = NewMenu (cur_submenu, "\pX");
2322 fill_submenu (submenu, wv->contents);
1a578e9b 2323 InsertMenu (submenu, -1);
61f1d295 2324 add_menu_item (menu, wv, cur_submenu, 0);
1a578e9b
AC
2325 }
2326 else
61f1d295 2327 add_menu_item (menu, wv, NULL, 0);
1a578e9b
AC
2328}
2329
2330/* Construct native Mac OS menubar based on widget_value tree. */
2331
2332static void
2333fill_menubar (widget_value *wv)
2334{
2335 int id;
2336
2337 submenu_id = MIN_SUBMENU_ID;
2338
2339 for (id = MIN_MENU_ID; wv != NULL; wv = wv->next, id++)
2340 {
2341 MenuHandle menu;
2342 Str255 title;
177c0ea7 2343
72742a99
AC
2344 strncpy (title, wv->name, 255);
2345 title[255] = 0;
1a578e9b
AC
2346 c2pstr (title);
2347 menu = NewMenu (id, title);
2348
2349 if (wv->contents)
2350 fill_menu (menu, wv->contents);
177c0ea7 2351
1a578e9b
AC
2352 InsertMenu (menu, 0);
2353 }
2354}
2355
2356#endif /* HAVE_MENUS */
e0f712ba 2357
1a578e9b
AC
2358\f
2359void
2360syms_of_macmenu ()
2361{
2362 staticpro (&menu_items);
2363 menu_items = Qnil;
2364
2365 Qdebug_on_next_call = intern ("debug-on-next-call");
2366 staticpro (&Qdebug_on_next_call);
2367
2368 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
e0f712ba
AC
2369 doc: /* Frame for which we are updating a menu.
2370The enable predicate for a menu command should check this variable. */);
1a578e9b
AC
2371 Vmenu_updating_frame = Qnil;
2372
2373 defsubr (&Sx_popup_menu);
2374#ifdef HAVE_MENUS
2375 defsubr (&Sx_popup_dialog);
2376#endif
2377}