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