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