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