(popup_activated_flag): New variable.
[bpt/emacs.git] / src / macmenu.c
1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
21
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
23
24 #include <config.h>
25
26 #include <stdio.h>
27
28 #include "lisp.h"
29 #include "termhooks.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "frame.h"
33 #include "window.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "charset.h"
37 #include "coding.h"
38
39 #if !TARGET_API_MAC_CARBON
40 #include <MacTypes.h>
41 #include <Menus.h>
42 #include <QuickDraw.h>
43 #include <ToolUtils.h>
44 #include <Fonts.h>
45 #include <Controls.h>
46 #include <Windows.h>
47 #include <Events.h>
48 #if defined (__MRC__) || (__MSL__ >= 0x6000)
49 #include <ControlDefinitions.h>
50 #endif
51 #endif /* not TARGET_API_MAC_CARBON */
52
53 /* This may include sys/types.h, and that somehow loses
54 if this is not done before the other system files. */
55 #include "macterm.h"
56
57 /* Load sys/types.h if not already loaded.
58 In some systems loading it twice is suicidal. */
59 #ifndef makedev
60 #include <sys/types.h>
61 #endif
62
63 #include "dispextern.h"
64
65 enum mac_menu_kind { /* Menu ID range */
66 MAC_MENU_APPLE, /* 0 (Reserved by Apple) */
67 MAC_MENU_MENU_BAR, /* 1 .. 233 */
68 MAC_MENU_M_APPLE, /* 234 (== M_APPLE) */
69 MAC_MENU_POPUP, /* 235 */
70 MAC_MENU_DRIVER, /* 236 .. 255 (Reserved) */
71 MAC_MENU_MENU_BAR_SUB, /* 256 .. 16383 */
72 MAC_MENU_POPUP_SUB, /* 16384 .. 32767 */
73 MAC_MENU_END /* 32768 */
74 };
75
76 static const int min_menu_id[] = {0, 1, 234, 235, 236, 256, 16384, 32768};
77
78 #define DIALOG_WINDOW_RESOURCE 130
79
80 #if TARGET_API_MAC_CARBON
81 #define HAVE_DIALOGS 1
82 #endif
83
84 #undef HAVE_MULTILINGUAL_MENU
85
86 /******************************************************************/
87 /* Definitions copied from lwlib.h */
88
89 typedef void * XtPointer;
90
91 enum button_type
92 {
93 BUTTON_TYPE_NONE,
94 BUTTON_TYPE_TOGGLE,
95 BUTTON_TYPE_RADIO
96 };
97
98 /* This structure is based on the one in ../lwlib/lwlib.h, modified
99 for Mac OS. */
100 typedef struct _widget_value
101 {
102 /* name of widget */
103 Lisp_Object lname;
104 char* name;
105 /* value (meaning depend on widget type) */
106 char* value;
107 /* keyboard equivalent. no implications for XtTranslations */
108 Lisp_Object lkey;
109 char* key;
110 /* Help string or nil if none.
111 GC finds this string through the frame's menu_bar_vector
112 or through menu_items. */
113 Lisp_Object help;
114 /* true if enabled */
115 Boolean enabled;
116 /* true if selected */
117 Boolean selected;
118 /* The type of a button. */
119 enum button_type button_type;
120 /* true if menu title */
121 Boolean title;
122 #if 0
123 /* true if was edited (maintained by get_value) */
124 Boolean edited;
125 /* true if has changed (maintained by lw library) */
126 change_type change;
127 /* true if this widget itself has changed,
128 but not counting the other widgets found in the `next' field. */
129 change_type this_one_change;
130 #endif
131 /* Contents of the sub-widgets, also selected slot for checkbox */
132 struct _widget_value* contents;
133 /* data passed to callback */
134 XtPointer call_data;
135 /* next one in the list */
136 struct _widget_value* next;
137 #if 0
138 /* slot for the toolkit dependent part. Always initialize to NULL. */
139 void* toolkit_data;
140 /* tell us if we should free the toolkit data slot when freeing the
141 widget_value itself. */
142 Boolean free_toolkit_data;
143
144 /* we resource the widget_value structures; this points to the next
145 one on the free list if this one has been deallocated.
146 */
147 struct _widget_value *free_list;
148 #endif
149 } widget_value;
150
151 /* Assumed by other routines to zero area returned. */
152 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
153 0, (sizeof (widget_value)))
154 #define free_widget_value(wv) xfree (wv)
155
156 /******************************************************************/
157
158 #ifndef TRUE
159 #define TRUE 1
160 #define FALSE 0
161 #endif /* no TRUE */
162
163 Lisp_Object Qdebug_on_next_call;
164
165 extern Lisp_Object Vmenu_updating_frame;
166
167 extern Lisp_Object Qmenu_bar, Qmac_apple_event;
168
169 extern Lisp_Object QCtoggle, QCradio;
170
171 extern Lisp_Object Voverriding_local_map;
172 extern Lisp_Object Voverriding_local_map_menu_flag;
173
174 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
175
176 extern Lisp_Object Qmenu_bar_update_hook;
177
178 void set_frame_menubar P_ ((FRAME_PTR, int, int));
179
180 #if TARGET_API_MAC_CARBON
181 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
182 #else
183 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
184 #endif
185
186 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
187 Lisp_Object, Lisp_Object, Lisp_Object,
188 Lisp_Object, Lisp_Object));
189 #ifdef HAVE_DIALOGS
190 static Lisp_Object mac_dialog_show P_ ((FRAME_PTR, int, Lisp_Object,
191 Lisp_Object, char **));
192 #endif
193 static Lisp_Object mac_menu_show P_ ((struct frame *, int, int, int, int,
194 Lisp_Object, char **));
195 static void keymap_panes P_ ((Lisp_Object *, int, int));
196 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
197 int, int));
198 static void list_of_panes P_ ((Lisp_Object));
199 static void list_of_items P_ ((Lisp_Object));
200
201 static void find_and_call_menu_selection P_ ((FRAME_PTR, int, Lisp_Object,
202 void *));
203 static int fill_menu P_ ((MenuHandle, widget_value *, enum mac_menu_kind, int));
204 static void fill_menubar P_ ((widget_value *, int));
205 static void dispose_menus P_ ((enum mac_menu_kind, int));
206
207 \f
208 /* This holds a Lisp vector that holds the results of decoding
209 the keymaps or alist-of-alists that specify a menu.
210
211 It describes the panes and items within the panes.
212
213 Each pane is described by 3 elements in the vector:
214 t, the pane name, the pane's prefix key.
215 Then follow the pane's items, with 5 elements per item:
216 the item string, the enable flag, the item's value,
217 the definition, and the equivalent keyboard key's description string.
218
219 In some cases, multiple levels of menus may be described.
220 A single vector slot containing nil indicates the start of a submenu.
221 A single vector slot containing lambda indicates the end of a submenu.
222 The submenu follows a menu item which is the way to reach the submenu.
223
224 A single vector slot containing quote indicates that the
225 following items should appear on the right of a dialog box.
226
227 Using a Lisp vector to hold this information while we decode it
228 takes care of protecting all the data from GC. */
229
230 #define MENU_ITEMS_PANE_NAME 1
231 #define MENU_ITEMS_PANE_PREFIX 2
232 #define MENU_ITEMS_PANE_LENGTH 3
233
234 enum menu_item_idx
235 {
236 MENU_ITEMS_ITEM_NAME = 0,
237 MENU_ITEMS_ITEM_ENABLE,
238 MENU_ITEMS_ITEM_VALUE,
239 MENU_ITEMS_ITEM_EQUIV_KEY,
240 MENU_ITEMS_ITEM_DEFINITION,
241 MENU_ITEMS_ITEM_TYPE,
242 MENU_ITEMS_ITEM_SELECTED,
243 MENU_ITEMS_ITEM_HELP,
244 MENU_ITEMS_ITEM_LENGTH
245 };
246
247 static Lisp_Object menu_items;
248
249 /* Number of slots currently allocated in menu_items. */
250 static int menu_items_allocated;
251
252 /* This is the index in menu_items of the first empty slot. */
253 static int menu_items_used;
254
255 /* The number of panes currently recorded in menu_items,
256 excluding those within submenus. */
257 static int menu_items_n_panes;
258
259 /* Current depth within submenus. */
260 static int menu_items_submenu_depth;
261
262 /* Nonzero means a menu is currently active. */
263 static int popup_activated_flag;
264
265 /* This is set nonzero after the user activates the menu bar, and set
266 to zero again after the menu bars are redisplayed by prepare_menu_bar.
267 While it is nonzero, all calls to set_frame_menubar go deep.
268
269 I don't understand why this is needed, but it does seem to be
270 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
271
272 int pending_menu_activation;
273 \f
274 /* Initialize the menu_items structure if we haven't already done so.
275 Also mark it as currently empty. */
276
277 static void
278 init_menu_items ()
279 {
280 if (NILP (menu_items))
281 {
282 menu_items_allocated = 60;
283 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
284 }
285
286 menu_items_used = 0;
287 menu_items_n_panes = 0;
288 menu_items_submenu_depth = 0;
289 }
290
291 /* Call at the end of generating the data in menu_items. */
292
293 static void
294 finish_menu_items ()
295 {
296 }
297
298 /* Call when finished using the data for the current menu
299 in menu_items. */
300
301 static void
302 discard_menu_items ()
303 {
304 /* Free the structure if it is especially large.
305 Otherwise, hold on to it, to save time. */
306 if (menu_items_allocated > 200)
307 {
308 menu_items = Qnil;
309 menu_items_allocated = 0;
310 }
311 }
312
313 /* This undoes save_menu_items, and it is called by the specpdl unwind
314 mechanism. */
315
316 static Lisp_Object
317 restore_menu_items (saved)
318 Lisp_Object saved;
319 {
320 menu_items = XCAR (saved);
321 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
322 saved = XCDR (saved);
323 menu_items_used = XINT (XCAR (saved));
324 saved = XCDR (saved);
325 menu_items_n_panes = XINT (XCAR (saved));
326 saved = XCDR (saved);
327 menu_items_submenu_depth = XINT (XCAR (saved));
328 return Qnil;
329 }
330
331 /* Push the whole state of menu_items processing onto the specpdl.
332 It will be restored when the specpdl is unwound. */
333
334 static void
335 save_menu_items ()
336 {
337 Lisp_Object saved = list4 (menu_items,
338 make_number (menu_items_used),
339 make_number (menu_items_n_panes),
340 make_number (menu_items_submenu_depth));
341 record_unwind_protect (restore_menu_items, saved);
342 menu_items = Qnil;
343 }
344 \f
345 /* Make the menu_items vector twice as large. */
346
347 static void
348 grow_menu_items ()
349 {
350 Lisp_Object old;
351 int old_size = menu_items_allocated;
352 old = menu_items;
353
354 menu_items_allocated *= 2;
355
356 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
357 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
358 old_size * sizeof (Lisp_Object));
359 }
360
361 /* Begin a submenu. */
362
363 static void
364 push_submenu_start ()
365 {
366 if (menu_items_used + 1 > menu_items_allocated)
367 grow_menu_items ();
368
369 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
370 menu_items_submenu_depth++;
371 }
372
373 /* End a submenu. */
374
375 static void
376 push_submenu_end ()
377 {
378 if (menu_items_used + 1 > menu_items_allocated)
379 grow_menu_items ();
380
381 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
382 menu_items_submenu_depth--;
383 }
384
385 /* Indicate boundary between left and right. */
386
387 static void
388 push_left_right_boundary ()
389 {
390 if (menu_items_used + 1 > menu_items_allocated)
391 grow_menu_items ();
392
393 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
394 }
395
396 /* Start a new menu pane in menu_items.
397 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
398
399 static void
400 push_menu_pane (name, prefix_vec)
401 Lisp_Object name, prefix_vec;
402 {
403 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
404 grow_menu_items ();
405
406 if (menu_items_submenu_depth == 0)
407 menu_items_n_panes++;
408 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
409 XVECTOR (menu_items)->contents[menu_items_used++] = name;
410 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
411 }
412
413 /* Push one menu item into the current pane. NAME is the string to
414 display. ENABLE if non-nil means this item can be selected. KEY
415 is the key generated by choosing this item, or nil if this item
416 doesn't really have a definition. DEF is the definition of this
417 item. EQUIV is the textual description of the keyboard equivalent
418 for this item (or nil if none). TYPE is the type of this menu
419 item, one of nil, `toggle' or `radio'. */
420
421 static void
422 push_menu_item (name, enable, key, def, equiv, type, selected, help)
423 Lisp_Object name, enable, key, def, equiv, type, selected, help;
424 {
425 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
426 grow_menu_items ();
427
428 XVECTOR (menu_items)->contents[menu_items_used++] = name;
429 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
430 XVECTOR (menu_items)->contents[menu_items_used++] = key;
431 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
432 XVECTOR (menu_items)->contents[menu_items_used++] = def;
433 XVECTOR (menu_items)->contents[menu_items_used++] = type;
434 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
435 XVECTOR (menu_items)->contents[menu_items_used++] = help;
436 }
437 \f
438 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
439 and generate menu panes for them in menu_items.
440 If NOTREAL is nonzero,
441 don't bother really computing whether an item is enabled. */
442
443 static void
444 keymap_panes (keymaps, nmaps, notreal)
445 Lisp_Object *keymaps;
446 int nmaps;
447 int notreal;
448 {
449 int mapno;
450
451 init_menu_items ();
452
453 /* Loop over the given keymaps, making a pane for each map.
454 But don't make a pane that is empty--ignore that map instead.
455 P is the number of panes we have made so far. */
456 for (mapno = 0; mapno < nmaps; mapno++)
457 single_keymap_panes (keymaps[mapno],
458 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
459
460 finish_menu_items ();
461 }
462
463 /* Args passed between single_keymap_panes and single_menu_item. */
464 struct skp
465 {
466 Lisp_Object pending_maps;
467 int maxdepth, notreal;
468 };
469
470 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
471 void *));
472
473 /* This is a recursive subroutine of keymap_panes.
474 It handles one keymap, KEYMAP.
475 The other arguments are passed along
476 or point to local variables of the previous function.
477 If NOTREAL is nonzero, only check for equivalent key bindings, don't
478 evaluate expressions in menu items and don't make any menu.
479
480 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
481
482 static void
483 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
484 Lisp_Object keymap;
485 Lisp_Object pane_name;
486 Lisp_Object prefix;
487 int notreal;
488 int maxdepth;
489 {
490 struct skp skp;
491 struct gcpro gcpro1;
492
493 skp.pending_maps = Qnil;
494 skp.maxdepth = maxdepth;
495 skp.notreal = notreal;
496
497 if (maxdepth <= 0)
498 return;
499
500 push_menu_pane (pane_name, prefix);
501
502 GCPRO1 (skp.pending_maps);
503 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
504 UNGCPRO;
505
506 /* Process now any submenus which want to be panes at this level. */
507 while (CONSP (skp.pending_maps))
508 {
509 Lisp_Object elt, eltcdr, string;
510 elt = XCAR (skp.pending_maps);
511 eltcdr = XCDR (elt);
512 string = XCAR (eltcdr);
513 /* We no longer discard the @ from the beginning of the string here.
514 Instead, we do this in mac_menu_show. */
515 single_keymap_panes (Fcar (elt), string,
516 XCDR (eltcdr), notreal, maxdepth - 1);
517 skp.pending_maps = XCDR (skp.pending_maps);
518 }
519 }
520 \f
521 /* This is a subroutine of single_keymap_panes that handles one
522 keymap entry.
523 KEY is a key in a keymap and ITEM is its binding.
524 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
525 separate panes.
526 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
527 evaluate expressions in menu items and don't make any menu.
528 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
529
530 static void
531 single_menu_item (key, item, dummy, skp_v)
532 Lisp_Object key, item, dummy;
533 void *skp_v;
534 {
535 Lisp_Object map, item_string, enabled;
536 struct gcpro gcpro1, gcpro2;
537 int res;
538 struct skp *skp = skp_v;
539
540 /* Parse the menu item and leave the result in item_properties. */
541 GCPRO2 (key, item);
542 res = parse_menu_item (item, skp->notreal, 0);
543 UNGCPRO;
544 if (!res)
545 return; /* Not a menu item. */
546
547 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
548
549 if (skp->notreal)
550 {
551 /* We don't want to make a menu, just traverse the keymaps to
552 precompute equivalent key bindings. */
553 if (!NILP (map))
554 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
555 return;
556 }
557
558 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
559 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
560
561 if (!NILP (map) && SREF (item_string, 0) == '@')
562 {
563 if (!NILP (enabled))
564 /* An enabled separate pane. Remember this to handle it later. */
565 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
566 skp->pending_maps);
567 return;
568 }
569
570 push_menu_item (item_string, enabled, key,
571 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
572 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
573 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
574 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
575 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
576
577 /* Display a submenu using the toolkit. */
578 if (! (NILP (map) || NILP (enabled)))
579 {
580 push_submenu_start ();
581 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
582 push_submenu_end ();
583 }
584 }
585 \f
586 /* Push all the panes and items of a menu described by the
587 alist-of-alists MENU.
588 This handles old-fashioned calls to x-popup-menu. */
589
590 static void
591 list_of_panes (menu)
592 Lisp_Object menu;
593 {
594 Lisp_Object tail;
595
596 init_menu_items ();
597
598 for (tail = menu; CONSP (tail); tail = XCDR (tail))
599 {
600 Lisp_Object elt, pane_name, pane_data;
601 elt = XCAR (tail);
602 pane_name = Fcar (elt);
603 CHECK_STRING (pane_name);
604 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
605 pane_data = Fcdr (elt);
606 CHECK_CONS (pane_data);
607 list_of_items (pane_data);
608 }
609
610 finish_menu_items ();
611 }
612
613 /* Push the items in a single pane defined by the alist PANE. */
614
615 static void
616 list_of_items (pane)
617 Lisp_Object pane;
618 {
619 Lisp_Object tail, item, item1;
620
621 for (tail = pane; CONSP (tail); tail = XCDR (tail))
622 {
623 item = XCAR (tail);
624 if (STRINGP (item))
625 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
626 Qnil, Qnil, Qnil, Qnil);
627 else if (CONSP (item))
628 {
629 item1 = XCAR (item);
630 CHECK_STRING (item1);
631 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
632 Qt, Qnil, Qnil, Qnil, Qnil);
633 }
634 else
635 push_left_right_boundary ();
636
637 }
638 }
639 \f
640 static Lisp_Object
641 cleanup_popup_menu (arg)
642 Lisp_Object arg;
643 {
644 discard_menu_items ();
645 return Qnil;
646 }
647
648 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
649 doc: /* Pop up a deck-of-cards menu and return user's selection.
650 POSITION is a position specification. This is either a mouse button event
651 or a list ((XOFFSET YOFFSET) WINDOW)
652 where XOFFSET and YOFFSET are positions in pixels from the top left
653 corner of WINDOW. (WINDOW may be a window or a frame object.)
654 This controls the position of the top left of the menu as a whole.
655 If POSITION is t, it means to use the current mouse position.
656
657 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
658 The menu items come from key bindings that have a menu string as well as
659 a definition; actually, the "definition" in such a key binding looks like
660 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
661 the keymap as a top-level element.
662
663 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
664 Otherwise, REAL-DEFINITION should be a valid key binding definition.
665
666 You can also use a list of keymaps as MENU.
667 Then each keymap makes a separate pane.
668
669 When MENU is a keymap or a list of keymaps, the return value is the
670 list of events corresponding to the user's choice. Note that
671 `x-popup-menu' does not actually execute the command bound to that
672 sequence of events.
673
674 Alternatively, you can specify a menu of multiple panes
675 with a list of the form (TITLE PANE1 PANE2...),
676 where each pane is a list of form (TITLE ITEM1 ITEM2...).
677 Each ITEM is normally a cons cell (STRING . VALUE);
678 but a string can appear as an item--that makes a nonselectable line
679 in the menu.
680 With this form of menu, the return value is VALUE from the chosen item.
681
682 If POSITION is nil, don't display the menu at all, just precalculate the
683 cached information about equivalent key sequences.
684
685 If the user gets rid of the menu without making a valid choice, for
686 instance by clicking the mouse away from a valid choice or by typing
687 keyboard input, then this normally results in a quit and
688 `x-popup-menu' does not return. But if POSITION is a mouse button
689 event (indicating that the user invoked the menu with the mouse) then
690 no quit occurs and `x-popup-menu' returns nil. */)
691 (position, menu)
692 Lisp_Object position, menu;
693 {
694 Lisp_Object keymap, tem;
695 int xpos = 0, ypos = 0;
696 Lisp_Object title;
697 char *error_name = NULL;
698 Lisp_Object selection;
699 FRAME_PTR f = NULL;
700 Lisp_Object x, y, window;
701 int keymaps = 0;
702 int for_click = 0;
703 int specpdl_count = SPECPDL_INDEX ();
704 struct gcpro gcpro1;
705
706 #ifdef HAVE_MENUS
707 if (! NILP (position))
708 {
709 check_mac ();
710
711 /* Decode the first argument: find the window and the coordinates. */
712 if (EQ (position, Qt)
713 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
714 || EQ (XCAR (position), Qtool_bar)
715 || EQ (XCAR (position), Qmac_apple_event))))
716 {
717 /* Use the mouse's current position. */
718 FRAME_PTR new_f = SELECTED_FRAME ();
719 Lisp_Object bar_window;
720 enum scroll_bar_part part;
721 unsigned long time;
722
723 if (mouse_position_hook)
724 (*mouse_position_hook) (&new_f, 1, &bar_window,
725 &part, &x, &y, &time);
726 if (new_f != 0)
727 XSETFRAME (window, new_f);
728 else
729 {
730 window = selected_window;
731 XSETFASTINT (x, 0);
732 XSETFASTINT (y, 0);
733 }
734 }
735 else
736 {
737 tem = Fcar (position);
738 if (CONSP (tem))
739 {
740 window = Fcar (Fcdr (position));
741 x = XCAR (tem);
742 y = Fcar (XCDR (tem));
743 }
744 else
745 {
746 for_click = 1;
747 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
748 window = Fcar (tem); /* POSN_WINDOW (tem) */
749 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
750 x = Fcar (tem);
751 y = Fcdr (tem);
752 }
753 }
754
755 CHECK_NUMBER (x);
756 CHECK_NUMBER (y);
757
758 /* Decode where to put the menu. */
759
760 if (FRAMEP (window))
761 {
762 f = XFRAME (window);
763 xpos = 0;
764 ypos = 0;
765 }
766 else if (WINDOWP (window))
767 {
768 CHECK_LIVE_WINDOW (window);
769 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
770
771 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
772 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
773 }
774 else
775 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
776 but I don't want to make one now. */
777 CHECK_WINDOW (window);
778
779 xpos += XINT (x);
780 ypos += XINT (y);
781
782 XSETFRAME (Vmenu_updating_frame, f);
783 }
784 else
785 Vmenu_updating_frame = Qnil;
786 #endif /* HAVE_MENUS */
787
788 title = Qnil;
789 GCPRO1 (title);
790
791 /* Decode the menu items from what was specified. */
792
793 keymap = get_keymap (menu, 0, 0);
794 if (CONSP (keymap))
795 {
796 /* We were given a keymap. Extract menu info from the keymap. */
797 Lisp_Object prompt;
798
799 /* Extract the detailed info to make one pane. */
800 keymap_panes (&menu, 1, NILP (position));
801
802 /* Search for a string appearing directly as an element of the keymap.
803 That string is the title of the menu. */
804 prompt = Fkeymap_prompt (keymap);
805 if (NILP (title) && !NILP (prompt))
806 title = prompt;
807
808 /* Make that be the pane title of the first pane. */
809 if (!NILP (prompt) && menu_items_n_panes >= 0)
810 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
811
812 keymaps = 1;
813 }
814 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
815 {
816 /* We were given a list of keymaps. */
817 int nmaps = XFASTINT (Flength (menu));
818 Lisp_Object *maps
819 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
820 int i;
821
822 title = Qnil;
823
824 /* The first keymap that has a prompt string
825 supplies the menu title. */
826 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
827 {
828 Lisp_Object prompt;
829
830 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
831
832 prompt = Fkeymap_prompt (keymap);
833 if (NILP (title) && !NILP (prompt))
834 title = prompt;
835 }
836
837 /* Extract the detailed info to make one pane. */
838 keymap_panes (maps, nmaps, NILP (position));
839
840 /* Make the title be the pane title of the first pane. */
841 if (!NILP (title) && menu_items_n_panes >= 0)
842 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
843
844 keymaps = 1;
845 }
846 else
847 {
848 /* We were given an old-fashioned menu. */
849 title = Fcar (menu);
850 CHECK_STRING (title);
851
852 list_of_panes (Fcdr (menu));
853
854 keymaps = 0;
855 }
856
857 if (NILP (position))
858 {
859 discard_menu_items ();
860 UNGCPRO;
861 return Qnil;
862 }
863
864 #ifdef HAVE_MENUS
865 /* Display them in a menu. */
866 record_unwind_protect (cleanup_popup_menu, Qnil);
867 BLOCK_INPUT;
868
869 selection = mac_menu_show (f, xpos, ypos, for_click,
870 keymaps, title, &error_name);
871 UNBLOCK_INPUT;
872 unbind_to (specpdl_count, Qnil);
873
874 UNGCPRO;
875 #endif /* HAVE_MENUS */
876
877 if (error_name) error (error_name);
878 return selection;
879 }
880
881 #ifdef HAVE_MENUS
882
883 /* Regard ESC and C-g as Cancel even without the Cancel button. */
884
885 #ifdef MAC_OSX
886 static Boolean
887 mac_dialog_modal_filter (dialog, event, item_hit)
888 DialogRef dialog;
889 EventRecord *event;
890 DialogItemIndex *item_hit;
891 {
892 Boolean result;
893
894 result = StdFilterProc (dialog, event, item_hit);
895 if (result == false
896 && (event->what == keyDown || event->what == autoKey)
897 && ((event->message & charCodeMask) == kEscapeCharCode
898 || mac_quit_char_key_p (event->modifiers,
899 (event->message & keyCodeMask) >> 8)))
900 {
901 *item_hit = kStdCancelItemIndex;
902 return true;
903 }
904
905 return result;
906 }
907 #endif
908
909 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
910 doc: /* Pop up a dialog box and return user's selection.
911 POSITION specifies which frame to use.
912 This is normally a mouse button event or a window or frame.
913 If POSITION is t, it means to use the frame the mouse is on.
914 The dialog box appears in the middle of the specified frame.
915
916 CONTENTS specifies the alternatives to display in the dialog box.
917 It is a list of the form (DIALOG ITEM1 ITEM2...).
918 Each ITEM is a cons cell (STRING . VALUE).
919 The return value is VALUE from the chosen item.
920
921 An ITEM may also be just a string--that makes a nonselectable item.
922 An ITEM may also be nil--that means to put all preceding items
923 on the left of the dialog box and all following items on the right.
924 \(By default, approximately half appear on each side.)
925
926 If HEADER is non-nil, the frame title for the box is "Information",
927 otherwise it is "Question".
928
929 If the user gets rid of the dialog box without making a valid choice,
930 for instance using the window manager, then this produces a quit and
931 `x-popup-dialog' does not return. */)
932 (position, contents, header)
933 Lisp_Object position, contents, header;
934 {
935 FRAME_PTR f = NULL;
936 Lisp_Object window;
937
938 check_mac ();
939
940 /* Decode the first argument: find the window or frame to use. */
941 if (EQ (position, Qt)
942 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
943 || EQ (XCAR (position), Qtool_bar)
944 || EQ (XCAR (position), Qmac_apple_event))))
945 {
946 #if 0 /* Using the frame the mouse is on may not be right. */
947 /* Use the mouse's current position. */
948 FRAME_PTR new_f = SELECTED_FRAME ();
949 Lisp_Object bar_window;
950 enum scroll_bar_part part;
951 unsigned long time;
952 Lisp_Object x, y;
953
954 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
955
956 if (new_f != 0)
957 XSETFRAME (window, new_f);
958 else
959 window = selected_window;
960 #endif
961 window = selected_window;
962 }
963 else if (CONSP (position))
964 {
965 Lisp_Object tem;
966 tem = Fcar (position);
967 if (CONSP (tem))
968 window = Fcar (Fcdr (position));
969 else
970 {
971 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
972 window = Fcar (tem); /* POSN_WINDOW (tem) */
973 }
974 }
975 else if (WINDOWP (position) || FRAMEP (position))
976 window = position;
977 else
978 window = Qnil;
979
980 /* Decode where to put the menu. */
981
982 if (FRAMEP (window))
983 f = XFRAME (window);
984 else if (WINDOWP (window))
985 {
986 CHECK_LIVE_WINDOW (window);
987 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
988 }
989 else
990 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
991 but I don't want to make one now. */
992 CHECK_WINDOW (window);
993
994 #ifdef MAC_OSX
995 /* Special treatment for Fmessage_box, Fyes_or_no_p, and Fy_or_n_p. */
996 if (EQ (position, Qt)
997 && STRINGP (Fcar (contents))
998 && ((!NILP (Fequal (XCDR (contents),
999 Fcons (Fcons (build_string ("OK"), Qt), Qnil)))
1000 && EQ (header, Qt))
1001 || (!NILP (Fequal (XCDR (contents),
1002 Fcons (Fcons (build_string ("Yes"), Qt),
1003 Fcons (Fcons (build_string ("No"), Qnil),
1004 Qnil))))
1005 && NILP (header))))
1006 {
1007 OSStatus err = noErr;
1008 AlertStdCFStringAlertParamRec param;
1009 CFStringRef error_string, explanation_string;
1010 DialogRef alert;
1011 DialogItemIndex item_hit;
1012 Lisp_Object tem;
1013
1014 tem = Fstring_match (concat3 (build_string ("\\("),
1015 call0 (intern ("sentence-end")),
1016 build_string ("\\)\n")),
1017 XCAR (contents), Qnil);
1018 BLOCK_INPUT;
1019 if (NILP (tem))
1020 {
1021 error_string = cfstring_create_with_string (XCAR (contents));
1022 if (error_string == NULL)
1023 err = memFullErr;
1024 explanation_string = NULL;
1025 }
1026 else
1027 {
1028 tem = Fmatch_end (make_number (1));
1029 error_string =
1030 cfstring_create_with_string (Fsubstring (XCAR (contents),
1031 make_number (0), tem));
1032 if (error_string == NULL)
1033 err = memFullErr;
1034 else
1035 {
1036 XSETINT (tem, XINT (tem) + 1);
1037 explanation_string =
1038 cfstring_create_with_string (Fsubstring (XCAR (contents),
1039 tem, Qnil));
1040 if (explanation_string == NULL)
1041 {
1042 CFRelease (error_string);
1043 err = memFullErr;
1044 }
1045 }
1046 }
1047 if (err == noErr)
1048 err = GetStandardAlertDefaultParams (&param,
1049 kStdCFStringAlertVersionOne);
1050 if (err == noErr)
1051 {
1052 param.movable = true;
1053 param.position = kWindowAlertPositionParentWindow;
1054 if (NILP (header))
1055 {
1056 param.defaultText = CFSTR ("Yes");
1057 param.otherText = CFSTR ("No");
1058 #if 0
1059 param.cancelText = CFSTR ("Cancel");
1060 param.cancelButton = kAlertStdAlertCancelButton;
1061 #endif
1062 }
1063 err = CreateStandardAlert (kAlertNoteAlert, error_string,
1064 explanation_string, &param, &alert);
1065 CFRelease (error_string);
1066 if (explanation_string)
1067 CFRelease (explanation_string);
1068 }
1069 if (err == noErr)
1070 err = RunStandardAlert (alert, mac_dialog_modal_filter, &item_hit);
1071 UNBLOCK_INPUT;
1072
1073 if (err == noErr)
1074 {
1075 if (item_hit == kStdCancelItemIndex)
1076 Fsignal (Qquit, Qnil);
1077 else if (item_hit == kStdOkItemIndex)
1078 return Qt;
1079 else
1080 return Qnil;
1081 }
1082 }
1083 #endif
1084 #ifndef HAVE_DIALOGS
1085 /* Display a menu with these alternatives
1086 in the middle of frame F. */
1087 {
1088 Lisp_Object x, y, frame, newpos;
1089 XSETFRAME (frame, f);
1090 XSETINT (x, x_pixel_width (f) / 2);
1091 XSETINT (y, x_pixel_height (f) / 2);
1092 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1093
1094 return Fx_popup_menu (newpos,
1095 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1096 }
1097 #else /* HAVE_DIALOGS */
1098 {
1099 Lisp_Object title;
1100 char *error_name;
1101 Lisp_Object selection;
1102 int specpdl_count = SPECPDL_INDEX ();
1103
1104 /* Decode the dialog items from what was specified. */
1105 title = Fcar (contents);
1106 CHECK_STRING (title);
1107
1108 list_of_panes (Fcons (contents, Qnil));
1109
1110 /* Display them in a dialog box. */
1111 record_unwind_protect (cleanup_popup_menu, Qnil);
1112 BLOCK_INPUT;
1113 selection = mac_dialog_show (f, 0, title, header, &error_name);
1114 UNBLOCK_INPUT;
1115 unbind_to (specpdl_count, Qnil);
1116
1117 if (error_name) error (error_name);
1118 return selection;
1119 }
1120 #endif /* HAVE_DIALOGS */
1121 }
1122
1123 /* Activate the menu bar of frame F.
1124 This is called from keyboard.c when it gets the
1125 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1126
1127 To activate the menu bar, we use the button-press event location
1128 that was saved in saved_menu_event_location.
1129
1130 But first we recompute the menu bar contents (the whole tree).
1131
1132 The reason for saving the button event until here, instead of
1133 passing it to the toolkit right away, is that we can safely
1134 execute Lisp code. */
1135
1136 void
1137 x_activate_menubar (f)
1138 FRAME_PTR f;
1139 {
1140 SInt32 menu_choice;
1141 SInt16 menu_id, menu_item;
1142 extern Point saved_menu_event_location;
1143
1144 set_frame_menubar (f, 0, 1);
1145 BLOCK_INPUT;
1146
1147 popup_activated_flag = 1;
1148 menu_choice = MenuSelect (saved_menu_event_location);
1149 popup_activated_flag = 0;
1150 menu_id = HiWord (menu_choice);
1151 menu_item = LoWord (menu_choice);
1152
1153 #if !TARGET_API_MAC_CARBON
1154 if (menu_id == min_menu_id[MAC_MENU_M_APPLE])
1155 do_apple_menu (menu_item);
1156 else
1157 #endif
1158 if (menu_id)
1159 {
1160 MenuHandle menu = GetMenuHandle (menu_id);
1161
1162 if (menu)
1163 {
1164 UInt32 refcon;
1165
1166 GetMenuItemRefCon (menu, menu_item, &refcon);
1167 find_and_call_menu_selection (f, f->menu_bar_items_used,
1168 f->menu_bar_vector, (void *) refcon);
1169 }
1170 }
1171
1172 HiliteMenu (0);
1173
1174 UNBLOCK_INPUT;
1175 }
1176
1177 /* Find the menu selection and store it in the keyboard buffer.
1178 F is the frame the menu is on.
1179 MENU_BAR_ITEMS_USED is the length of VECTOR.
1180 VECTOR is an array of menu events for the whole menu. */
1181
1182 static void
1183 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
1184 FRAME_PTR f;
1185 int menu_bar_items_used;
1186 Lisp_Object vector;
1187 void *client_data;
1188 {
1189 Lisp_Object prefix, entry;
1190 Lisp_Object *subprefix_stack;
1191 int submenu_depth = 0;
1192 int i;
1193
1194 entry = Qnil;
1195 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
1196 prefix = Qnil;
1197 i = 0;
1198
1199 while (i < menu_bar_items_used)
1200 {
1201 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1202 {
1203 subprefix_stack[submenu_depth++] = prefix;
1204 prefix = entry;
1205 i++;
1206 }
1207 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1208 {
1209 prefix = subprefix_stack[--submenu_depth];
1210 i++;
1211 }
1212 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1213 {
1214 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1215 i += MENU_ITEMS_PANE_LENGTH;
1216 }
1217 else
1218 {
1219 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1220 /* The EMACS_INT cast avoids a warning. There's no problem
1221 as long as pointers have enough bits to hold small integers. */
1222 if ((int) (EMACS_INT) client_data == i)
1223 {
1224 int j;
1225 struct input_event buf;
1226 Lisp_Object frame;
1227 EVENT_INIT (buf);
1228
1229 XSETFRAME (frame, f);
1230 buf.kind = MENU_BAR_EVENT;
1231 buf.frame_or_window = frame;
1232 buf.arg = frame;
1233 kbd_buffer_store_event (&buf);
1234
1235 for (j = 0; j < submenu_depth; j++)
1236 if (!NILP (subprefix_stack[j]))
1237 {
1238 buf.kind = MENU_BAR_EVENT;
1239 buf.frame_or_window = frame;
1240 buf.arg = subprefix_stack[j];
1241 kbd_buffer_store_event (&buf);
1242 }
1243
1244 if (!NILP (prefix))
1245 {
1246 buf.kind = MENU_BAR_EVENT;
1247 buf.frame_or_window = frame;
1248 buf.arg = prefix;
1249 kbd_buffer_store_event (&buf);
1250 }
1251
1252 buf.kind = MENU_BAR_EVENT;
1253 buf.frame_or_window = frame;
1254 buf.arg = entry;
1255 kbd_buffer_store_event (&buf);
1256
1257 return;
1258 }
1259 i += MENU_ITEMS_ITEM_LENGTH;
1260 }
1261 }
1262 }
1263
1264 /* Allocate a widget_value, blocking input. */
1265
1266 widget_value *
1267 xmalloc_widget_value ()
1268 {
1269 widget_value *value;
1270
1271 BLOCK_INPUT;
1272 value = malloc_widget_value ();
1273 UNBLOCK_INPUT;
1274
1275 return value;
1276 }
1277
1278 /* This recursively calls free_widget_value on the tree of widgets.
1279 It must free all data that was malloc'ed for these widget_values.
1280 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1281 must be left alone. */
1282
1283 void
1284 free_menubar_widget_value_tree (wv)
1285 widget_value *wv;
1286 {
1287 if (! wv) return;
1288
1289 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1290
1291 if (wv->contents && (wv->contents != (widget_value*)1))
1292 {
1293 free_menubar_widget_value_tree (wv->contents);
1294 wv->contents = (widget_value *) 0xDEADBEEF;
1295 }
1296 if (wv->next)
1297 {
1298 free_menubar_widget_value_tree (wv->next);
1299 wv->next = (widget_value *) 0xDEADBEEF;
1300 }
1301 BLOCK_INPUT;
1302 free_widget_value (wv);
1303 UNBLOCK_INPUT;
1304 }
1305 \f
1306 /* Set up data in menu_items for a menu bar item
1307 whose event type is ITEM_KEY (with string ITEM_NAME)
1308 and whose contents come from the list of keymaps MAPS. */
1309
1310 static int
1311 parse_single_submenu (item_key, item_name, maps)
1312 Lisp_Object item_key, item_name, maps;
1313 {
1314 Lisp_Object length;
1315 int len;
1316 Lisp_Object *mapvec;
1317 int i;
1318 int top_level_items = 0;
1319
1320 length = Flength (maps);
1321 len = XINT (length);
1322
1323 /* Convert the list MAPS into a vector MAPVEC. */
1324 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1325 for (i = 0; i < len; i++)
1326 {
1327 mapvec[i] = Fcar (maps);
1328 maps = Fcdr (maps);
1329 }
1330
1331 /* Loop over the given keymaps, making a pane for each map.
1332 But don't make a pane that is empty--ignore that map instead. */
1333 for (i = 0; i < len; i++)
1334 {
1335 if (!KEYMAPP (mapvec[i]))
1336 {
1337 /* Here we have a command at top level in the menu bar
1338 as opposed to a submenu. */
1339 top_level_items = 1;
1340 push_menu_pane (Qnil, Qnil);
1341 push_menu_item (item_name, Qt, item_key, mapvec[i],
1342 Qnil, Qnil, Qnil, Qnil);
1343 }
1344 else
1345 {
1346 Lisp_Object prompt;
1347 prompt = Fkeymap_prompt (mapvec[i]);
1348 single_keymap_panes (mapvec[i],
1349 !NILP (prompt) ? prompt : item_name,
1350 item_key, 0, 10);
1351 }
1352 }
1353
1354 return top_level_items;
1355 }
1356
1357 /* Create a tree of widget_value objects
1358 representing the panes and items
1359 in menu_items starting at index START, up to index END. */
1360
1361 static widget_value *
1362 digest_single_submenu (start, end, top_level_items)
1363 int start, end, top_level_items;
1364 {
1365 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1366 int i;
1367 int submenu_depth = 0;
1368 widget_value **submenu_stack;
1369 int panes_seen = 0;
1370
1371 submenu_stack
1372 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1373 wv = xmalloc_widget_value ();
1374 wv->name = "menu";
1375 wv->value = 0;
1376 wv->enabled = 1;
1377 wv->button_type = BUTTON_TYPE_NONE;
1378 wv->help = Qnil;
1379 first_wv = wv;
1380 save_wv = 0;
1381 prev_wv = 0;
1382
1383 /* Loop over all panes and items made by the preceding call
1384 to parse_single_submenu and construct a tree of widget_value objects.
1385 Ignore the panes and items used by previous calls to
1386 digest_single_submenu, even though those are also in menu_items. */
1387 i = start;
1388 while (i < end)
1389 {
1390 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1391 {
1392 submenu_stack[submenu_depth++] = save_wv;
1393 save_wv = prev_wv;
1394 prev_wv = 0;
1395 i++;
1396 }
1397 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1398 {
1399 prev_wv = save_wv;
1400 save_wv = submenu_stack[--submenu_depth];
1401 i++;
1402 }
1403 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1404 && submenu_depth != 0)
1405 i += MENU_ITEMS_PANE_LENGTH;
1406 /* Ignore a nil in the item list.
1407 It's meaningful only for dialog boxes. */
1408 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1409 i += 1;
1410 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1411 {
1412 /* Create a new pane. */
1413 Lisp_Object pane_name, prefix;
1414 char *pane_string;
1415
1416 panes_seen++;
1417
1418 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1419 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1420
1421 #ifndef HAVE_MULTILINGUAL_MENU
1422 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1423 {
1424 pane_name = ENCODE_MENU_STRING (pane_name);
1425 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1426 }
1427 #endif
1428 pane_string = (NILP (pane_name)
1429 ? "" : (char *) SDATA (pane_name));
1430 /* If there is just one top-level pane, put all its items directly
1431 under the top-level menu. */
1432 if (menu_items_n_panes == 1)
1433 pane_string = "";
1434
1435 /* If the pane has a meaningful name,
1436 make the pane a top-level menu item
1437 with its items as a submenu beneath it. */
1438 if (strcmp (pane_string, ""))
1439 {
1440 wv = xmalloc_widget_value ();
1441 if (save_wv)
1442 save_wv->next = wv;
1443 else
1444 first_wv->contents = wv;
1445 wv->lname = pane_name;
1446 /* Set value to 1 so update_submenu_strings can handle '@' */
1447 wv->value = (char *)1;
1448 wv->enabled = 1;
1449 wv->button_type = BUTTON_TYPE_NONE;
1450 wv->help = Qnil;
1451 save_wv = wv;
1452 }
1453 else
1454 save_wv = first_wv;
1455
1456 prev_wv = 0;
1457 i += MENU_ITEMS_PANE_LENGTH;
1458 }
1459 else
1460 {
1461 /* Create a new item within current pane. */
1462 Lisp_Object item_name, enable, descrip, def, type, selected;
1463 Lisp_Object help;
1464
1465 /* All items should be contained in panes. */
1466 if (panes_seen == 0)
1467 abort ();
1468
1469 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1470 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1471 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1472 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1473 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1474 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1475 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1476
1477 #ifndef HAVE_MULTILINGUAL_MENU
1478 if (STRING_MULTIBYTE (item_name))
1479 {
1480 item_name = ENCODE_MENU_STRING (item_name);
1481 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1482 }
1483
1484 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1485 {
1486 descrip = ENCODE_MENU_STRING (descrip);
1487 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1488 }
1489 #endif /* not HAVE_MULTILINGUAL_MENU */
1490
1491 wv = xmalloc_widget_value ();
1492 if (prev_wv)
1493 prev_wv->next = wv;
1494 else
1495 save_wv->contents = wv;
1496
1497 wv->lname = item_name;
1498 if (!NILP (descrip))
1499 wv->lkey = descrip;
1500 wv->value = 0;
1501 /* The EMACS_INT cast avoids a warning. There's no problem
1502 as long as pointers have enough bits to hold small integers. */
1503 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1504 wv->enabled = !NILP (enable);
1505
1506 if (NILP (type))
1507 wv->button_type = BUTTON_TYPE_NONE;
1508 else if (EQ (type, QCradio))
1509 wv->button_type = BUTTON_TYPE_RADIO;
1510 else if (EQ (type, QCtoggle))
1511 wv->button_type = BUTTON_TYPE_TOGGLE;
1512 else
1513 abort ();
1514
1515 wv->selected = !NILP (selected);
1516 if (! STRINGP (help))
1517 help = Qnil;
1518
1519 wv->help = help;
1520
1521 prev_wv = wv;
1522
1523 i += MENU_ITEMS_ITEM_LENGTH;
1524 }
1525 }
1526
1527 /* If we have just one "menu item"
1528 that was originally a button, return it by itself. */
1529 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1530 {
1531 wv = first_wv->contents;
1532 free_widget_value (first_wv);
1533 return wv;
1534 }
1535
1536 return first_wv;
1537 }
1538
1539 /* Walk through the widget_value tree starting at FIRST_WV and update
1540 the char * pointers from the corresponding lisp values.
1541 We do this after building the whole tree, since GC may happen while the
1542 tree is constructed, and small strings are relocated. So we must wait
1543 until no GC can happen before storing pointers into lisp values. */
1544 static void
1545 update_submenu_strings (first_wv)
1546 widget_value *first_wv;
1547 {
1548 widget_value *wv;
1549
1550 for (wv = first_wv; wv; wv = wv->next)
1551 {
1552 if (STRINGP (wv->lname))
1553 {
1554 wv->name = SDATA (wv->lname);
1555
1556 /* Ignore the @ that means "separate pane".
1557 This is a kludge, but this isn't worth more time. */
1558 if (wv->value == (char *)1)
1559 {
1560 if (wv->name[0] == '@')
1561 wv->name++;
1562 wv->value = 0;
1563 }
1564 }
1565
1566 if (STRINGP (wv->lkey))
1567 wv->key = SDATA (wv->lkey);
1568
1569 if (wv->contents)
1570 update_submenu_strings (wv->contents);
1571 }
1572 }
1573
1574 \f
1575 #if TARGET_API_MAC_CARBON
1576 extern Lisp_Object Vshow_help_function;
1577
1578 static Lisp_Object
1579 restore_show_help_function (old_show_help_function)
1580 Lisp_Object old_show_help_function;
1581 {
1582 Vshow_help_function = old_show_help_function;
1583
1584 return Qnil;
1585 }
1586
1587 static pascal OSStatus
1588 menu_target_item_handler (next_handler, event, data)
1589 EventHandlerCallRef next_handler;
1590 EventRef event;
1591 void *data;
1592 {
1593 OSStatus err, result;
1594 MenuRef menu;
1595 MenuItemIndex menu_item;
1596 Lisp_Object help;
1597 GrafPtr port;
1598 int specpdl_count = SPECPDL_INDEX ();
1599
1600 result = CallNextEventHandler (next_handler, event);
1601
1602 err = GetEventParameter (event, kEventParamDirectObject, typeMenuRef,
1603 NULL, sizeof (MenuRef), NULL, &menu);
1604 if (err == noErr)
1605 err = GetEventParameter (event, kEventParamMenuItemIndex,
1606 typeMenuItemIndex, NULL,
1607 sizeof (MenuItemIndex), NULL, &menu_item);
1608 if (err == noErr)
1609 err = GetMenuItemProperty (menu, menu_item,
1610 MAC_EMACS_CREATOR_CODE, 'help',
1611 sizeof (Lisp_Object), NULL, &help);
1612 if (err != noErr)
1613 help = Qnil;
1614
1615 /* Temporarily bind Vshow_help_function to Qnil because we don't
1616 want tooltips during menu tracking. */
1617 record_unwind_protect (restore_show_help_function, Vshow_help_function);
1618 Vshow_help_function = Qnil;
1619 GetPort (&port);
1620 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1621 SetPort (port);
1622 unbind_to (specpdl_count, Qnil);
1623
1624 return err == noErr ? noErr : result;
1625 }
1626 #endif
1627
1628 OSStatus
1629 install_menu_target_item_handler (window)
1630 WindowPtr window;
1631 {
1632 OSStatus err = noErr;
1633 #if TARGET_API_MAC_CARBON
1634 static const EventTypeSpec specs[] =
1635 {{kEventClassMenu, kEventMenuTargetItem}};
1636 static EventHandlerUPP menu_target_item_handlerUPP = NULL;
1637
1638 if (menu_target_item_handlerUPP == NULL)
1639 menu_target_item_handlerUPP =
1640 NewEventHandlerUPP (menu_target_item_handler);
1641
1642 err = InstallWindowEventHandler (window, menu_target_item_handlerUPP,
1643 GetEventTypeCount (specs), specs,
1644 NULL, NULL);
1645 #endif
1646 return err;
1647 }
1648
1649 /* Event handler function that pops down a menu on C-g. We can only pop
1650 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1651
1652 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1653 static pascal OSStatus
1654 menu_quit_handler (nextHandler, theEvent, userData)
1655 EventHandlerCallRef nextHandler;
1656 EventRef theEvent;
1657 void* userData;
1658 {
1659 OSStatus err;
1660 UInt32 keyCode;
1661 UInt32 keyModifiers;
1662
1663 err = GetEventParameter (theEvent, kEventParamKeyCode,
1664 typeUInt32, NULL, sizeof(UInt32), NULL, &keyCode);
1665
1666 if (err == noErr)
1667 err = GetEventParameter (theEvent, kEventParamKeyModifiers,
1668 typeUInt32, NULL, sizeof(UInt32),
1669 NULL, &keyModifiers);
1670
1671 if (err == noErr && mac_quit_char_key_p (keyModifiers, keyCode))
1672 {
1673 MenuRef menu = userData != 0
1674 ? (MenuRef)userData : AcquireRootMenu ();
1675
1676 CancelMenuTracking (menu, true, 0);
1677 if (!userData) ReleaseMenu (menu);
1678 return noErr;
1679 }
1680
1681 return CallNextEventHandler (nextHandler, theEvent);
1682 }
1683 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1684
1685 /* Add event handler to all menus that belong to KIND so we can detect C-g.
1686 MENU_HANDLE is the root menu of the tracking session to dismiss
1687 when C-g is detected. NULL means the menu bar.
1688 If CancelMenuTracking isn't available, do nothing. */
1689
1690 static void
1691 install_menu_quit_handler (kind, menu_handle)
1692 enum mac_menu_kind kind;
1693 MenuHandle menu_handle;
1694 {
1695 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1696 static const EventTypeSpec typesList[] =
1697 {{kEventClassKeyboard, kEventRawKeyDown}};
1698 int id;
1699
1700 #if MAC_OS_X_VERSION_MIN_REQUIRED == 1020
1701 if (CancelMenuTracking == NULL)
1702 return;
1703 #endif
1704 for (id = min_menu_id[kind]; id < min_menu_id[kind + 1]; id++)
1705 {
1706 MenuHandle menu = GetMenuHandle (id);
1707
1708 if (menu == NULL)
1709 break;
1710 InstallMenuEventHandler (menu, menu_quit_handler,
1711 GetEventTypeCount (typesList),
1712 typesList, menu_handle, NULL);
1713 }
1714 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1715 }
1716
1717 /* Set the contents of the menubar widgets of frame F.
1718 The argument FIRST_TIME is currently ignored;
1719 it is set the first time this is called, from initialize_frame_menubar. */
1720
1721 void
1722 set_frame_menubar (f, first_time, deep_p)
1723 FRAME_PTR f;
1724 int first_time;
1725 int deep_p;
1726 {
1727 int menubar_widget = f->output_data.mac->menubar_widget;
1728 Lisp_Object items;
1729 widget_value *wv, *first_wv, *prev_wv = 0;
1730 int i, last_i = 0;
1731 int *submenu_start, *submenu_end;
1732 int *submenu_top_level_items, *submenu_n_panes;
1733
1734 XSETFRAME (Vmenu_updating_frame, f);
1735
1736 if (! menubar_widget)
1737 deep_p = 1;
1738 else if (pending_menu_activation && !deep_p)
1739 deep_p = 1;
1740
1741 if (deep_p)
1742 {
1743 /* Make a widget-value tree representing the entire menu trees. */
1744
1745 struct buffer *prev = current_buffer;
1746 Lisp_Object buffer;
1747 int specpdl_count = SPECPDL_INDEX ();
1748 int previous_menu_items_used = f->menu_bar_items_used;
1749 Lisp_Object *previous_items
1750 = (Lisp_Object *) alloca (previous_menu_items_used
1751 * sizeof (Lisp_Object));
1752
1753 /* If we are making a new widget, its contents are empty,
1754 do always reinitialize them. */
1755 if (! menubar_widget)
1756 previous_menu_items_used = 0;
1757
1758 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1759 specbind (Qinhibit_quit, Qt);
1760 /* Don't let the debugger step into this code
1761 because it is not reentrant. */
1762 specbind (Qdebug_on_next_call, Qnil);
1763
1764 record_unwind_save_match_data ();
1765 if (NILP (Voverriding_local_map_menu_flag))
1766 {
1767 specbind (Qoverriding_terminal_local_map, Qnil);
1768 specbind (Qoverriding_local_map, Qnil);
1769 }
1770
1771 set_buffer_internal_1 (XBUFFER (buffer));
1772
1773 /* Run the Lucid hook. */
1774 safe_run_hooks (Qactivate_menubar_hook);
1775
1776 /* If it has changed current-menubar from previous value,
1777 really recompute the menubar from the value. */
1778 if (! NILP (Vlucid_menu_bar_dirty_flag))
1779 call0 (Qrecompute_lucid_menubar);
1780 safe_run_hooks (Qmenu_bar_update_hook);
1781 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1782
1783 items = FRAME_MENU_BAR_ITEMS (f);
1784
1785 /* Save the frame's previous menu bar contents data. */
1786 if (previous_menu_items_used)
1787 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1788 previous_menu_items_used * sizeof (Lisp_Object));
1789
1790 /* Fill in menu_items with the current menu bar contents.
1791 This can evaluate Lisp code. */
1792 save_menu_items ();
1793
1794 menu_items = f->menu_bar_vector;
1795 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1796 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1797 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1798 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1799 submenu_top_level_items
1800 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1801 init_menu_items ();
1802 for (i = 0; i < XVECTOR (items)->size; i += 4)
1803 {
1804 Lisp_Object key, string, maps;
1805
1806 last_i = i;
1807
1808 key = XVECTOR (items)->contents[i];
1809 string = XVECTOR (items)->contents[i + 1];
1810 maps = XVECTOR (items)->contents[i + 2];
1811 if (NILP (string))
1812 break;
1813
1814 submenu_start[i] = menu_items_used;
1815
1816 menu_items_n_panes = 0;
1817 submenu_top_level_items[i]
1818 = parse_single_submenu (key, string, maps);
1819 submenu_n_panes[i] = menu_items_n_panes;
1820
1821 submenu_end[i] = menu_items_used;
1822 }
1823
1824 finish_menu_items ();
1825
1826 /* Convert menu_items into widget_value trees
1827 to display the menu. This cannot evaluate Lisp code. */
1828
1829 wv = xmalloc_widget_value ();
1830 wv->name = "menubar";
1831 wv->value = 0;
1832 wv->enabled = 1;
1833 wv->button_type = BUTTON_TYPE_NONE;
1834 wv->help = Qnil;
1835 first_wv = wv;
1836
1837 for (i = 0; i < last_i; i += 4)
1838 {
1839 menu_items_n_panes = submenu_n_panes[i];
1840 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1841 submenu_top_level_items[i]);
1842 if (prev_wv)
1843 prev_wv->next = wv;
1844 else
1845 first_wv->contents = wv;
1846 /* Don't set wv->name here; GC during the loop might relocate it. */
1847 wv->enabled = 1;
1848 wv->button_type = BUTTON_TYPE_NONE;
1849 prev_wv = wv;
1850 }
1851
1852 set_buffer_internal_1 (prev);
1853
1854 /* If there has been no change in the Lisp-level contents
1855 of the menu bar, skip redisplaying it. Just exit. */
1856
1857 /* Compare the new menu items with the ones computed last time. */
1858 for (i = 0; i < previous_menu_items_used; i++)
1859 if (menu_items_used == i
1860 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1861 break;
1862 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1863 {
1864 /* The menu items have not changed. Don't bother updating
1865 the menus in any form, since it would be a no-op. */
1866 free_menubar_widget_value_tree (first_wv);
1867 discard_menu_items ();
1868 unbind_to (specpdl_count, Qnil);
1869 return;
1870 }
1871
1872 /* The menu items are different, so store them in the frame. */
1873 f->menu_bar_vector = menu_items;
1874 f->menu_bar_items_used = menu_items_used;
1875
1876 /* This calls restore_menu_items to restore menu_items, etc.,
1877 as they were outside. */
1878 unbind_to (specpdl_count, Qnil);
1879
1880 /* Now GC cannot happen during the lifetime of the widget_value,
1881 so it's safe to store data from a Lisp_String. */
1882 wv = first_wv->contents;
1883 for (i = 0; i < XVECTOR (items)->size; i += 4)
1884 {
1885 Lisp_Object string;
1886 string = XVECTOR (items)->contents[i + 1];
1887 if (NILP (string))
1888 break;
1889 wv->name = (char *) SDATA (string);
1890 update_submenu_strings (wv->contents);
1891 wv = wv->next;
1892 }
1893
1894 }
1895 else
1896 {
1897 /* Make a widget-value tree containing
1898 just the top level menu bar strings. */
1899
1900 wv = xmalloc_widget_value ();
1901 wv->name = "menubar";
1902 wv->value = 0;
1903 wv->enabled = 1;
1904 wv->button_type = BUTTON_TYPE_NONE;
1905 wv->help = Qnil;
1906 first_wv = wv;
1907
1908 items = FRAME_MENU_BAR_ITEMS (f);
1909 for (i = 0; i < XVECTOR (items)->size; i += 4)
1910 {
1911 Lisp_Object string;
1912
1913 string = XVECTOR (items)->contents[i + 1];
1914 if (NILP (string))
1915 break;
1916
1917 wv = xmalloc_widget_value ();
1918 wv->name = (char *) SDATA (string);
1919 wv->value = 0;
1920 wv->enabled = 1;
1921 wv->button_type = BUTTON_TYPE_NONE;
1922 wv->help = Qnil;
1923 /* This prevents lwlib from assuming this
1924 menu item is really supposed to be empty. */
1925 /* The EMACS_INT cast avoids a warning.
1926 This value just has to be different from small integers. */
1927 wv->call_data = (void *) (EMACS_INT) (-1);
1928
1929 if (prev_wv)
1930 prev_wv->next = wv;
1931 else
1932 first_wv->contents = wv;
1933 prev_wv = wv;
1934 }
1935
1936 /* Forget what we thought we knew about what is in the
1937 detailed contents of the menu bar menus.
1938 Changing the top level always destroys the contents. */
1939 f->menu_bar_items_used = 0;
1940 }
1941
1942 /* Create or update the menu bar widget. */
1943
1944 BLOCK_INPUT;
1945
1946 /* Non-null value to indicate menubar has already been "created". */
1947 f->output_data.mac->menubar_widget = 1;
1948
1949 fill_menubar (first_wv->contents, deep_p);
1950
1951 /* Add event handler so we can detect C-g. */
1952 install_menu_quit_handler (MAC_MENU_MENU_BAR, NULL);
1953 install_menu_quit_handler (MAC_MENU_MENU_BAR_SUB, NULL);
1954 free_menubar_widget_value_tree (first_wv);
1955
1956 UNBLOCK_INPUT;
1957 }
1958
1959 /* Get rid of the menu bar of frame F, and free its storage.
1960 This is used when deleting a frame, and when turning off the menu bar. */
1961
1962 void
1963 free_frame_menubar (f)
1964 FRAME_PTR f;
1965 {
1966 f->output_data.mac->menubar_widget = 0;
1967 }
1968
1969 \f
1970 static Lisp_Object
1971 pop_down_menu (arg)
1972 Lisp_Object arg;
1973 {
1974 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
1975 FRAME_PTR f = p->pointer;
1976 MenuHandle menu = GetMenuHandle (min_menu_id[MAC_MENU_POPUP]);
1977
1978 BLOCK_INPUT;
1979
1980 /* Must reset this manually because the button release event is not
1981 passed to Emacs event loop. */
1982 FRAME_MAC_DISPLAY_INFO (f)->grabbed = 0;
1983
1984 /* delete all menus */
1985 dispose_menus (MAC_MENU_POPUP_SUB, 0);
1986 DeleteMenu (min_menu_id[MAC_MENU_POPUP]);
1987 DisposeMenu (menu);
1988
1989 UNBLOCK_INPUT;
1990
1991 return Qnil;
1992 }
1993
1994 /* Mac_menu_show actually displays a menu using the panes and items in
1995 menu_items and returns the value selected from it; we assume input
1996 is blocked by the caller. */
1997
1998 /* F is the frame the menu is for.
1999 X and Y are the frame-relative specified position,
2000 relative to the inside upper left corner of the frame F.
2001 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2002 KEYMAPS is 1 if this menu was specified with keymaps;
2003 in that case, we return a list containing the chosen item's value
2004 and perhaps also the pane's prefix.
2005 TITLE is the specified menu title.
2006 ERROR is a place to store an error message string in case of failure.
2007 (We return nil on failure, but the value doesn't actually matter.) */
2008
2009 static Lisp_Object
2010 mac_menu_show (f, x, y, for_click, keymaps, title, error)
2011 FRAME_PTR f;
2012 int x;
2013 int y;
2014 int for_click;
2015 int keymaps;
2016 Lisp_Object title;
2017 char **error;
2018 {
2019 int i;
2020 int menu_item_choice;
2021 UInt32 menu_item_selection;
2022 MenuHandle menu;
2023 Point pos;
2024 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2025 widget_value **submenu_stack
2026 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
2027 Lisp_Object *subprefix_stack
2028 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
2029 int submenu_depth = 0;
2030
2031 int first_pane;
2032 int specpdl_count = SPECPDL_INDEX ();
2033
2034 *error = NULL;
2035
2036 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2037 {
2038 *error = "Empty menu";
2039 return Qnil;
2040 }
2041
2042 /* Create a tree of widget_value objects
2043 representing the panes and their items. */
2044 wv = xmalloc_widget_value ();
2045 wv->name = "menu";
2046 wv->value = 0;
2047 wv->enabled = 1;
2048 wv->button_type = BUTTON_TYPE_NONE;
2049 wv->help = Qnil;
2050 first_wv = wv;
2051 first_pane = 1;
2052
2053 /* Loop over all panes and items, filling in the tree. */
2054 i = 0;
2055 while (i < menu_items_used)
2056 {
2057 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2058 {
2059 submenu_stack[submenu_depth++] = save_wv;
2060 save_wv = prev_wv;
2061 prev_wv = 0;
2062 first_pane = 1;
2063 i++;
2064 }
2065 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2066 {
2067 prev_wv = save_wv;
2068 save_wv = submenu_stack[--submenu_depth];
2069 first_pane = 0;
2070 i++;
2071 }
2072 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2073 && submenu_depth != 0)
2074 i += MENU_ITEMS_PANE_LENGTH;
2075 /* Ignore a nil in the item list.
2076 It's meaningful only for dialog boxes. */
2077 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2078 i += 1;
2079 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2080 {
2081 /* Create a new pane. */
2082 Lisp_Object pane_name, prefix;
2083 char *pane_string;
2084
2085 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2086 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2087
2088 #ifndef HAVE_MULTILINGUAL_MENU
2089 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2090 {
2091 pane_name = ENCODE_MENU_STRING (pane_name);
2092 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2093 }
2094 #endif
2095 pane_string = (NILP (pane_name)
2096 ? "" : (char *) SDATA (pane_name));
2097 /* If there is just one top-level pane, put all its items directly
2098 under the top-level menu. */
2099 if (menu_items_n_panes == 1)
2100 pane_string = "";
2101
2102 /* If the pane has a meaningful name,
2103 make the pane a top-level menu item
2104 with its items as a submenu beneath it. */
2105 if (!keymaps && strcmp (pane_string, ""))
2106 {
2107 wv = xmalloc_widget_value ();
2108 if (save_wv)
2109 save_wv->next = wv;
2110 else
2111 first_wv->contents = wv;
2112 wv->name = pane_string;
2113 if (keymaps && !NILP (prefix))
2114 wv->name++;
2115 wv->value = 0;
2116 wv->enabled = 1;
2117 wv->button_type = BUTTON_TYPE_NONE;
2118 wv->help = Qnil;
2119 save_wv = wv;
2120 prev_wv = 0;
2121 }
2122 else if (first_pane)
2123 {
2124 save_wv = wv;
2125 prev_wv = 0;
2126 }
2127 first_pane = 0;
2128 i += MENU_ITEMS_PANE_LENGTH;
2129 }
2130 else
2131 {
2132 /* Create a new item within current pane. */
2133 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2134 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2135 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2136 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2137 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2138 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2139 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2140 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2141
2142 #ifndef HAVE_MULTILINGUAL_MENU
2143 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2144 {
2145 item_name = ENCODE_MENU_STRING (item_name);
2146 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2147 }
2148
2149 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2150 {
2151 descrip = ENCODE_MENU_STRING (descrip);
2152 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2153 }
2154 #endif /* not HAVE_MULTILINGUAL_MENU */
2155
2156 wv = xmalloc_widget_value ();
2157 if (prev_wv)
2158 prev_wv->next = wv;
2159 else
2160 save_wv->contents = wv;
2161 wv->name = (char *) SDATA (item_name);
2162 if (!NILP (descrip))
2163 wv->key = (char *) SDATA (descrip);
2164 wv->value = 0;
2165 /* Use the contents index as call_data, since we are
2166 restricted to 16-bits. */
2167 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
2168 wv->enabled = !NILP (enable);
2169
2170 if (NILP (type))
2171 wv->button_type = BUTTON_TYPE_NONE;
2172 else if (EQ (type, QCtoggle))
2173 wv->button_type = BUTTON_TYPE_TOGGLE;
2174 else if (EQ (type, QCradio))
2175 wv->button_type = BUTTON_TYPE_RADIO;
2176 else
2177 abort ();
2178
2179 wv->selected = !NILP (selected);
2180
2181 if (! STRINGP (help))
2182 help = Qnil;
2183
2184 wv->help = help;
2185
2186 prev_wv = wv;
2187
2188 i += MENU_ITEMS_ITEM_LENGTH;
2189 }
2190 }
2191
2192 /* Deal with the title, if it is non-nil. */
2193 if (!NILP (title))
2194 {
2195 widget_value *wv_title = xmalloc_widget_value ();
2196 widget_value *wv_sep = xmalloc_widget_value ();
2197
2198 /* Maybe replace this separator with a bitmap or owner-draw item
2199 so that it looks better. Having two separators looks odd. */
2200 wv_sep->name = "--";
2201 wv_sep->next = first_wv->contents;
2202 wv_sep->help = Qnil;
2203
2204 #ifndef HAVE_MULTILINGUAL_MENU
2205 if (STRING_MULTIBYTE (title))
2206 title = ENCODE_MENU_STRING (title);
2207 #endif
2208
2209 wv_title->name = (char *) SDATA (title);
2210 wv_title->enabled = FALSE;
2211 wv_title->title = TRUE;
2212 wv_title->button_type = BUTTON_TYPE_NONE;
2213 wv_title->help = Qnil;
2214 wv_title->next = wv_sep;
2215 first_wv->contents = wv_title;
2216 }
2217
2218 /* Actually create the menu. */
2219 menu = NewMenu (min_menu_id[MAC_MENU_POPUP], "\p");
2220 InsertMenu (menu, -1);
2221 fill_menu (menu, first_wv->contents, MAC_MENU_POPUP_SUB,
2222 min_menu_id[MAC_MENU_POPUP_SUB]);
2223
2224 /* Free the widget_value objects we used to specify the
2225 contents. */
2226 free_menubar_widget_value_tree (first_wv);
2227
2228 /* Adjust coordinates to be root-window-relative. */
2229 pos.h = x;
2230 pos.v = y;
2231
2232 SetPortWindowPort (FRAME_MAC_WINDOW (f));
2233 LocalToGlobal (&pos);
2234
2235 /* No selection has been chosen yet. */
2236 menu_item_selection = 0;
2237
2238 record_unwind_protect (pop_down_menu, make_save_value (f, 0));
2239
2240 /* Add event handler so we can detect C-g. */
2241 install_menu_quit_handler (MAC_MENU_POPUP, menu);
2242 install_menu_quit_handler (MAC_MENU_POPUP_SUB, menu);
2243
2244 /* Display the menu. */
2245 popup_activated_flag = 1;
2246 menu_item_choice = PopUpMenuSelect (menu, pos.v, pos.h, 0);
2247 popup_activated_flag = 0;
2248
2249 /* Get the refcon to find the correct item */
2250 if (menu_item_choice)
2251 {
2252 MenuHandle sel_menu = GetMenuHandle (HiWord (menu_item_choice));
2253
2254 if (sel_menu)
2255 GetMenuItemRefCon (sel_menu, LoWord (menu_item_choice),
2256 &menu_item_selection);
2257 }
2258
2259 unbind_to (specpdl_count, Qnil);
2260
2261 /* Find the selected item, and its pane, to return
2262 the proper value. */
2263 if (menu_item_selection != 0)
2264 {
2265 Lisp_Object prefix, entry;
2266
2267 prefix = entry = Qnil;
2268 i = 0;
2269 while (i < menu_items_used)
2270 {
2271 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2272 {
2273 subprefix_stack[submenu_depth++] = prefix;
2274 prefix = entry;
2275 i++;
2276 }
2277 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2278 {
2279 prefix = subprefix_stack[--submenu_depth];
2280 i++;
2281 }
2282 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2283 {
2284 prefix
2285 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2286 i += MENU_ITEMS_PANE_LENGTH;
2287 }
2288 /* Ignore a nil in the item list.
2289 It's meaningful only for dialog boxes. */
2290 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2291 i += 1;
2292 else
2293 {
2294 entry
2295 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2296 if (menu_item_selection == i)
2297 {
2298 if (keymaps != 0)
2299 {
2300 int j;
2301
2302 entry = Fcons (entry, Qnil);
2303 if (!NILP (prefix))
2304 entry = Fcons (prefix, entry);
2305 for (j = submenu_depth - 1; j >= 0; j--)
2306 if (!NILP (subprefix_stack[j]))
2307 entry = Fcons (subprefix_stack[j], entry);
2308 }
2309 return entry;
2310 }
2311 i += MENU_ITEMS_ITEM_LENGTH;
2312 }
2313 }
2314 }
2315 else if (!for_click)
2316 /* Make "Cancel" equivalent to C-g. */
2317 Fsignal (Qquit, Qnil);
2318
2319 return Qnil;
2320 }
2321 \f
2322
2323 #ifdef HAVE_DIALOGS
2324 /* Construct native Mac OS dialog based on widget_value tree. */
2325
2326 #if TARGET_API_MAC_CARBON
2327
2328 static pascal OSStatus
2329 mac_handle_dialog_event (next_handler, event, data)
2330 EventHandlerCallRef next_handler;
2331 EventRef event;
2332 void *data;
2333 {
2334 OSStatus err;
2335 WindowRef window = (WindowRef) data;
2336
2337 switch (GetEventClass (event))
2338 {
2339 case kEventClassCommand:
2340 {
2341 HICommand command;
2342
2343 err = GetEventParameter (event, kEventParamDirectObject,
2344 typeHICommand, NULL, sizeof (HICommand),
2345 NULL, &command);
2346 if (err == noErr)
2347 if ((command.commandID & ~0xffff) == 'Bt\0\0')
2348 {
2349 SetWRefCon (window, command.commandID);
2350 err = QuitAppModalLoopForWindow (window);
2351
2352 return err == noErr ? noErr : eventNotHandledErr;
2353 }
2354
2355 return CallNextEventHandler (next_handler, event);
2356 }
2357 break;
2358
2359 case kEventClassKeyboard:
2360 {
2361 OSStatus result;
2362 char char_code;
2363
2364 result = CallNextEventHandler (next_handler, event);
2365 if (result == noErr)
2366 return noErr;
2367
2368 err = GetEventParameter (event, kEventParamKeyMacCharCodes,
2369 typeChar, NULL, sizeof (char),
2370 NULL, &char_code);
2371 if (err == noErr)
2372 switch (char_code)
2373 {
2374 case kEscapeCharCode:
2375 err = QuitAppModalLoopForWindow (window);
2376 break;
2377
2378 default:
2379 {
2380 UInt32 modifiers, key_code;
2381
2382 err = GetEventParameter (event, kEventParamKeyModifiers,
2383 typeUInt32, NULL, sizeof (UInt32),
2384 NULL, &modifiers);
2385 if (err == noErr)
2386 err = GetEventParameter (event, kEventParamKeyCode,
2387 typeUInt32, NULL, sizeof (UInt32),
2388 NULL, &key_code);
2389 if (err == noErr)
2390 {
2391 if (mac_quit_char_key_p (modifiers, key_code))
2392 err = QuitAppModalLoopForWindow (window);
2393 else
2394 err = eventNotHandledErr;
2395 }
2396 }
2397 break;
2398 }
2399
2400 return err == noErr ? noErr : result;
2401 }
2402 break;
2403
2404 default:
2405 abort ();
2406 }
2407 }
2408
2409 static OSStatus
2410 install_dialog_event_handler (window)
2411 WindowRef window;
2412 {
2413 static const EventTypeSpec specs[] =
2414 {{kEventClassCommand, kEventCommandProcess},
2415 {kEventClassKeyboard, kEventRawKeyDown}};
2416 static EventHandlerUPP handle_dialog_eventUPP = NULL;
2417
2418 if (handle_dialog_eventUPP == NULL)
2419 handle_dialog_eventUPP = NewEventHandlerUPP (mac_handle_dialog_event);
2420 return InstallWindowEventHandler (window, handle_dialog_eventUPP,
2421 GetEventTypeCount (specs), specs,
2422 window, NULL);
2423 }
2424
2425 #define DIALOG_LEFT_MARGIN (112)
2426 #define DIALOG_TOP_MARGIN (24)
2427 #define DIALOG_RIGHT_MARGIN (24)
2428 #define DIALOG_BOTTOM_MARGIN (20)
2429 #define DIALOG_MIN_INNER_WIDTH (338)
2430 #define DIALOG_MAX_INNER_WIDTH (564)
2431 #define DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE (12)
2432 #define DIALOG_BUTTON_BUTTON_VERTICAL_SPACE (12)
2433 #define DIALOG_BUTTON_MIN_WIDTH (68)
2434 #define DIALOG_TEXT_MIN_HEIGHT (50)
2435 #define DIALOG_TEXT_BUTTONS_VERTICAL_SPACE (10)
2436 #define DIALOG_ICON_WIDTH (64)
2437 #define DIALOG_ICON_HEIGHT (64)
2438 #define DIALOG_ICON_LEFT_MARGIN (24)
2439 #define DIALOG_ICON_TOP_MARGIN (15)
2440
2441 static int
2442 create_and_show_dialog (f, first_wv)
2443 FRAME_PTR f;
2444 widget_value *first_wv;
2445 {
2446 OSStatus err;
2447 char *dialog_name, *message;
2448 int nb_buttons, first_group_count, i, result = 0;
2449 widget_value *wv;
2450 short buttons_height, text_height, inner_width, inner_height;
2451 Rect empty_rect, *rects;
2452 WindowRef window = NULL;
2453 ControlRef *buttons, default_button = NULL, text;
2454
2455 dialog_name = first_wv->name;
2456 nb_buttons = dialog_name[1] - '0';
2457 first_group_count = nb_buttons - (dialog_name[4] - '0');
2458
2459 wv = first_wv->contents;
2460 message = wv->value;
2461
2462 wv = wv->next;
2463 SetRect (&empty_rect, 0, 0, 0, 0);
2464
2465 /* Create dialog window. */
2466 err = CreateNewWindow (kMovableModalWindowClass,
2467 kWindowStandardHandlerAttribute,
2468 &empty_rect, &window);
2469 if (err == noErr)
2470 err = SetThemeWindowBackground (window, kThemeBrushMovableModalBackground,
2471 true);
2472 if (err == noErr)
2473 err = SetWindowTitleWithCFString (window, (dialog_name[0] == 'Q'
2474 ? CFSTR ("Question")
2475 : CFSTR ("Information")));
2476
2477 /* Create button controls and measure their optimal bounds. */
2478 if (err == noErr)
2479 {
2480 buttons = alloca (sizeof (ControlRef) * nb_buttons);
2481 rects = alloca (sizeof (Rect) * nb_buttons);
2482 for (i = 0; i < nb_buttons; i++)
2483 {
2484 CFStringRef label = cfstring_create_with_utf8_cstring (wv->value);
2485
2486 if (label == NULL)
2487 err = memFullErr;
2488 else
2489 {
2490 err = CreatePushButtonControl (window, &empty_rect,
2491 label, &buttons[i]);
2492 CFRelease (label);
2493 }
2494 if (err == noErr)
2495 {
2496 if (!wv->enabled)
2497 {
2498 #ifdef MAC_OSX
2499 err = DisableControl (buttons[i]);
2500 #else
2501 err = DeactivateControl (buttons[i]);
2502 #endif
2503 }
2504 else if (default_button == NULL)
2505 default_button = buttons[i];
2506 }
2507 if (err == noErr)
2508 {
2509 SInt16 unused;
2510
2511 rects[i] = empty_rect;
2512 err = GetBestControlRect (buttons[i], &rects[i], &unused);
2513 }
2514 if (err == noErr)
2515 {
2516 OffsetRect (&rects[i], -rects[i].left, -rects[i].top);
2517 if (rects[i].right < DIALOG_BUTTON_MIN_WIDTH)
2518 rects[i].right = DIALOG_BUTTON_MIN_WIDTH;
2519 else if (rects[i].right > DIALOG_MAX_INNER_WIDTH)
2520 rects[i].right = DIALOG_MAX_INNER_WIDTH;
2521
2522 err = SetControlCommandID (buttons[i],
2523 'Bt\0\0' + (int) wv->call_data);
2524 }
2525 if (err != noErr)
2526 break;
2527 wv = wv->next;
2528 }
2529 }
2530
2531 /* Layout buttons. rects[i] is set relative to the bottom-right
2532 corner of the inner box. */
2533 if (err == noErr)
2534 {
2535 short bottom, right, max_height, left_align_shift;
2536
2537 inner_width = DIALOG_MIN_INNER_WIDTH;
2538 bottom = right = max_height = 0;
2539 for (i = 0; i < nb_buttons; i++)
2540 {
2541 if (right - rects[i].right < - inner_width)
2542 {
2543 if (i != first_group_count
2544 && right - rects[i].right >= - DIALOG_MAX_INNER_WIDTH)
2545 inner_width = - (right - rects[i].right);
2546 else
2547 {
2548 bottom -= max_height + DIALOG_BUTTON_BUTTON_VERTICAL_SPACE;
2549 right = max_height = 0;
2550 }
2551 }
2552 if (max_height < rects[i].bottom)
2553 max_height = rects[i].bottom;
2554 OffsetRect (&rects[i], right - rects[i].right,
2555 bottom - rects[i].bottom);
2556 right = rects[i].left - DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE;
2557 if (i == first_group_count - 1)
2558 right -= DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE;
2559 }
2560 buttons_height = - (bottom - max_height);
2561
2562 left_align_shift = - (inner_width + rects[nb_buttons - 1].left);
2563 for (i = nb_buttons - 1; i >= first_group_count; i--)
2564 {
2565 if (bottom != rects[i].bottom)
2566 {
2567 left_align_shift = - (inner_width + rects[i].left);
2568 bottom = rects[i].bottom;
2569 }
2570 OffsetRect (&rects[i], left_align_shift, 0);
2571 }
2572 }
2573
2574 /* Create a static text control and measure its bounds. */
2575 if (err == noErr)
2576 {
2577 CFStringRef message_string;
2578 Rect bounds;
2579
2580 message_string = cfstring_create_with_utf8_cstring (message);
2581 if (message_string == NULL)
2582 err = memFullErr;
2583 else
2584 {
2585 ControlFontStyleRec text_style;
2586
2587 text_style.flags = 0;
2588 SetRect (&bounds, 0, 0, inner_width, 0);
2589 err = CreateStaticTextControl (window, &bounds, message_string,
2590 &text_style, &text);
2591 CFRelease (message_string);
2592 }
2593 if (err == noErr)
2594 {
2595 SInt16 unused;
2596
2597 bounds = empty_rect;
2598 err = GetBestControlRect (text, &bounds, &unused);
2599 }
2600 if (err == noErr)
2601 {
2602 text_height = bounds.bottom - bounds.top;
2603 if (text_height < DIALOG_TEXT_MIN_HEIGHT)
2604 text_height = DIALOG_TEXT_MIN_HEIGHT;
2605 }
2606 }
2607
2608 /* Place buttons. */
2609 if (err == noErr)
2610 {
2611 inner_height = (text_height + DIALOG_TEXT_BUTTONS_VERTICAL_SPACE
2612 + buttons_height);
2613
2614 for (i = 0; i < nb_buttons; i++)
2615 {
2616 OffsetRect (&rects[i], DIALOG_LEFT_MARGIN + inner_width,
2617 DIALOG_TOP_MARGIN + inner_height);
2618 SetControlBounds (buttons[i], &rects[i]);
2619 }
2620 }
2621
2622 /* Place text. */
2623 if (err == noErr)
2624 {
2625 Rect bounds;
2626
2627 SetRect (&bounds, DIALOG_LEFT_MARGIN, DIALOG_TOP_MARGIN,
2628 DIALOG_LEFT_MARGIN + inner_width,
2629 DIALOG_TOP_MARGIN + text_height);
2630 SetControlBounds (text, &bounds);
2631 }
2632
2633 /* Create the application icon at the upper-left corner. */
2634 if (err == noErr)
2635 {
2636 ControlButtonContentInfo content;
2637 ControlRef icon;
2638 static const ProcessSerialNumber psn = {0, kCurrentProcess};
2639 #ifdef MAC_OSX
2640 FSRef app_location;
2641 #else
2642 ProcessInfoRec pinfo;
2643 FSSpec app_spec;
2644 #endif
2645 SInt16 unused;
2646
2647 content.contentType = kControlContentIconRef;
2648 #ifdef MAC_OSX
2649 err = GetProcessBundleLocation (&psn, &app_location);
2650 if (err == noErr)
2651 err = GetIconRefFromFileInfo (&app_location, 0, NULL, 0, NULL,
2652 kIconServicesNormalUsageFlag,
2653 &content.u.iconRef, &unused);
2654 #else
2655 bzero (&pinfo, sizeof (ProcessInfoRec));
2656 pinfo.processInfoLength = sizeof (ProcessInfoRec);
2657 pinfo.processAppSpec = &app_spec;
2658 err = GetProcessInformation (&psn, &pinfo);
2659 if (err == noErr)
2660 err = GetIconRefFromFile (&app_spec, &content.u.iconRef, &unused);
2661 #endif
2662 if (err == noErr)
2663 {
2664 Rect bounds;
2665
2666 SetRect (&bounds, DIALOG_ICON_LEFT_MARGIN, DIALOG_ICON_TOP_MARGIN,
2667 DIALOG_ICON_LEFT_MARGIN + DIALOG_ICON_WIDTH,
2668 DIALOG_ICON_TOP_MARGIN + DIALOG_ICON_HEIGHT);
2669 err = CreateIconControl (window, &bounds, &content, true, &icon);
2670 ReleaseIconRef (content.u.iconRef);
2671 }
2672 }
2673
2674 /* Show the dialog window and run event loop. */
2675 if (err == noErr)
2676 if (default_button)
2677 err = SetWindowDefaultButton (window, default_button);
2678 if (err == noErr)
2679 err = install_dialog_event_handler (window);
2680 if (err == noErr)
2681 {
2682 SizeWindow (window,
2683 DIALOG_LEFT_MARGIN + inner_width + DIALOG_RIGHT_MARGIN,
2684 DIALOG_TOP_MARGIN + inner_height + DIALOG_BOTTOM_MARGIN,
2685 true);
2686 err = RepositionWindow (window, FRAME_MAC_WINDOW (f),
2687 kWindowAlertPositionOnParentWindow);
2688 }
2689 if (err == noErr)
2690 {
2691 SetWRefCon (window, 0);
2692 ShowWindow (window);
2693 BringToFront (window);
2694 err = RunAppModalLoopForWindow (window);
2695 }
2696 if (err == noErr)
2697 {
2698 UInt32 command_id = GetWRefCon (window);
2699
2700 if ((command_id & ~0xffff) == 'Bt\0\0')
2701 result = command_id - 'Bt\0\0';
2702 }
2703
2704 if (window)
2705 DisposeWindow (window);
2706
2707 return result;
2708 }
2709 #else /* not TARGET_API_MAC_CARBON */
2710 static int
2711 mac_dialog (widget_value *wv)
2712 {
2713 char *dialog_name;
2714 char *prompt;
2715 char **button_labels;
2716 UInt32 *ref_cons;
2717 int nb_buttons;
2718 int left_count;
2719 int i;
2720 int dialog_width;
2721 Rect rect;
2722 WindowPtr window_ptr;
2723 ControlHandle ch;
2724 int left;
2725 EventRecord event_record;
2726 SInt16 part_code;
2727 int control_part_code;
2728 Point mouse;
2729
2730 dialog_name = wv->name;
2731 nb_buttons = dialog_name[1] - '0';
2732 left_count = nb_buttons - (dialog_name[4] - '0');
2733 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
2734 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
2735
2736 wv = wv->contents;
2737 prompt = (char *) alloca (strlen (wv->value) + 1);
2738 strcpy (prompt, wv->value);
2739 c2pstr (prompt);
2740
2741 wv = wv->next;
2742 for (i = 0; i < nb_buttons; i++)
2743 {
2744 button_labels[i] = wv->value;
2745 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
2746 strcpy (button_labels[i], wv->value);
2747 c2pstr (button_labels[i]);
2748 ref_cons[i] = (UInt32) wv->call_data;
2749 wv = wv->next;
2750 }
2751
2752 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
2753
2754 SetPortWindowPort (window_ptr);
2755
2756 TextFont (0);
2757 /* Left and right margins in the dialog are 13 pixels each.*/
2758 dialog_width = 14;
2759 /* Calculate width of dialog box: 8 pixels on each side of the text
2760 label in each button, 12 pixels between buttons. */
2761 for (i = 0; i < nb_buttons; i++)
2762 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
2763
2764 if (left_count != 0 && nb_buttons - left_count != 0)
2765 dialog_width += 12;
2766
2767 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
2768
2769 SizeWindow (window_ptr, dialog_width, 78, 0);
2770 ShowWindow (window_ptr);
2771
2772 SetPortWindowPort (window_ptr);
2773
2774 TextFont (0);
2775
2776 MoveTo (13, 29);
2777 DrawString (prompt);
2778
2779 left = 13;
2780 for (i = 0; i < nb_buttons; i++)
2781 {
2782 int button_width = StringWidth (button_labels[i]) + 16;
2783 SetRect (&rect, left, 45, left + button_width, 65);
2784 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2785 kControlPushButtonProc, ref_cons[i]);
2786 left += button_width + 12;
2787 if (i == left_count - 1)
2788 left += 12;
2789 }
2790
2791 i = 0;
2792 while (!i)
2793 {
2794 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2795 if (event_record.what == mouseDown)
2796 {
2797 part_code = FindWindow (event_record.where, &window_ptr);
2798 if (part_code == inContent)
2799 {
2800 mouse = event_record.where;
2801 GlobalToLocal (&mouse);
2802 control_part_code = FindControl (mouse, window_ptr, &ch);
2803 if (control_part_code == kControlButtonPart)
2804 if (TrackControl (ch, mouse, NULL))
2805 i = GetControlReference (ch);
2806 }
2807 }
2808 }
2809
2810 DisposeWindow (window_ptr);
2811
2812 return i;
2813 }
2814 #endif /* not TARGET_API_MAC_CARBON */
2815
2816 static char * button_names [] = {
2817 "button1", "button2", "button3", "button4", "button5",
2818 "button6", "button7", "button8", "button9", "button10" };
2819
2820 static Lisp_Object
2821 mac_dialog_show (f, keymaps, title, header, error_name)
2822 FRAME_PTR f;
2823 int keymaps;
2824 Lisp_Object title, header;
2825 char **error_name;
2826 {
2827 int i, nb_buttons=0;
2828 char dialog_name[6];
2829 int menu_item_selection;
2830
2831 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2832
2833 /* Number of elements seen so far, before boundary. */
2834 int left_count = 0;
2835 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2836 int boundary_seen = 0;
2837
2838 *error_name = NULL;
2839
2840 if (menu_items_n_panes > 1)
2841 {
2842 *error_name = "Multiple panes in dialog box";
2843 return Qnil;
2844 }
2845
2846 /* Create a tree of widget_value objects
2847 representing the text label and buttons. */
2848 {
2849 Lisp_Object pane_name, prefix;
2850 char *pane_string;
2851 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2852 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2853 pane_string = (NILP (pane_name)
2854 ? "" : (char *) SDATA (pane_name));
2855 prev_wv = xmalloc_widget_value ();
2856 prev_wv->value = pane_string;
2857 if (keymaps && !NILP (prefix))
2858 prev_wv->name++;
2859 prev_wv->enabled = 1;
2860 prev_wv->name = "message";
2861 prev_wv->help = Qnil;
2862 first_wv = prev_wv;
2863
2864 /* Loop over all panes and items, filling in the tree. */
2865 i = MENU_ITEMS_PANE_LENGTH;
2866 while (i < menu_items_used)
2867 {
2868
2869 /* Create a new item within current pane. */
2870 Lisp_Object item_name, enable, descrip;
2871 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2872 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2873 descrip
2874 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2875
2876 if (NILP (item_name))
2877 {
2878 free_menubar_widget_value_tree (first_wv);
2879 *error_name = "Submenu in dialog items";
2880 return Qnil;
2881 }
2882 if (EQ (item_name, Qquote))
2883 {
2884 /* This is the boundary between left-side elts
2885 and right-side elts. Stop incrementing right_count. */
2886 boundary_seen = 1;
2887 i++;
2888 continue;
2889 }
2890 if (nb_buttons >= 9)
2891 {
2892 free_menubar_widget_value_tree (first_wv);
2893 *error_name = "Too many dialog items";
2894 return Qnil;
2895 }
2896
2897 wv = xmalloc_widget_value ();
2898 prev_wv->next = wv;
2899 wv->name = (char *) button_names[nb_buttons];
2900 if (!NILP (descrip))
2901 wv->key = (char *) SDATA (descrip);
2902 wv->value = (char *) SDATA (item_name);
2903 wv->call_data = (void *) i;
2904 /* menu item is identified by its index in menu_items table */
2905 wv->enabled = !NILP (enable);
2906 wv->help = Qnil;
2907 prev_wv = wv;
2908
2909 if (! boundary_seen)
2910 left_count++;
2911
2912 nb_buttons++;
2913 i += MENU_ITEMS_ITEM_LENGTH;
2914 }
2915
2916 /* If the boundary was not specified,
2917 by default put half on the left and half on the right. */
2918 if (! boundary_seen)
2919 left_count = nb_buttons - nb_buttons / 2;
2920
2921 wv = xmalloc_widget_value ();
2922 wv->name = dialog_name;
2923 wv->help = Qnil;
2924
2925 /* Frame title: 'Q' = Question, 'I' = Information.
2926 Can also have 'E' = Error if, one day, we want
2927 a popup for errors. */
2928 if (NILP(header))
2929 dialog_name[0] = 'Q';
2930 else
2931 dialog_name[0] = 'I';
2932
2933 /* Dialog boxes use a really stupid name encoding
2934 which specifies how many buttons to use
2935 and how many buttons are on the right. */
2936 dialog_name[1] = '0' + nb_buttons;
2937 dialog_name[2] = 'B';
2938 dialog_name[3] = 'R';
2939 /* Number of buttons to put on the right. */
2940 dialog_name[4] = '0' + nb_buttons - left_count;
2941 dialog_name[5] = 0;
2942 wv->contents = first_wv;
2943 first_wv = wv;
2944 }
2945
2946 /* Actually create the dialog. */
2947 #if TARGET_API_MAC_CARBON
2948 menu_item_selection = create_and_show_dialog (f, first_wv);
2949 #else
2950 menu_item_selection = mac_dialog (first_wv);
2951 #endif
2952
2953 /* Free the widget_value objects we used to specify the contents. */
2954 free_menubar_widget_value_tree (first_wv);
2955
2956 /* Find the selected item, and its pane, to return
2957 the proper value. */
2958 if (menu_item_selection != 0)
2959 {
2960 Lisp_Object prefix;
2961
2962 prefix = Qnil;
2963 i = 0;
2964 while (i < menu_items_used)
2965 {
2966 Lisp_Object entry;
2967
2968 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2969 {
2970 prefix
2971 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2972 i += MENU_ITEMS_PANE_LENGTH;
2973 }
2974 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2975 {
2976 /* This is the boundary between left-side elts and
2977 right-side elts. */
2978 ++i;
2979 }
2980 else
2981 {
2982 entry
2983 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2984 if (menu_item_selection == i)
2985 {
2986 if (keymaps != 0)
2987 {
2988 entry = Fcons (entry, Qnil);
2989 if (!NILP (prefix))
2990 entry = Fcons (prefix, entry);
2991 }
2992 return entry;
2993 }
2994 i += MENU_ITEMS_ITEM_LENGTH;
2995 }
2996 }
2997 }
2998 else
2999 /* Make "Cancel" equivalent to C-g. */
3000 Fsignal (Qquit, Qnil);
3001
3002 return Qnil;
3003 }
3004 #endif /* HAVE_DIALOGS */
3005 \f
3006
3007 /* Is this item a separator? */
3008 static int
3009 name_is_separator (name)
3010 const char *name;
3011 {
3012 const char *start = name;
3013
3014 /* Check if name string consists of only dashes ('-'). */
3015 while (*name == '-') name++;
3016 /* Separators can also be of the form "--:TripleSuperMegaEtched"
3017 or "--deep-shadow". We don't implement them yet, se we just treat
3018 them like normal separators. */
3019 return (*name == '\0' || start + 2 == name);
3020 }
3021
3022 static void
3023 add_menu_item (menu, pos, wv)
3024 MenuHandle menu;
3025 int pos;
3026 widget_value *wv;
3027 {
3028 #if TARGET_API_MAC_CARBON
3029 CFStringRef item_name;
3030 #else
3031 Str255 item_name;
3032 #endif
3033
3034 if (name_is_separator (wv->name))
3035 AppendMenu (menu, "\p-");
3036 else
3037 {
3038 AppendMenu (menu, "\pX");
3039
3040 #if TARGET_API_MAC_CARBON
3041 item_name = cfstring_create_with_utf8_cstring (wv->name);
3042
3043 if (wv->key != NULL)
3044 {
3045 CFStringRef name, key;
3046
3047 name = item_name;
3048 key = cfstring_create_with_utf8_cstring (wv->key);
3049 item_name = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@ %@"),
3050 name, key);
3051 CFRelease (name);
3052 CFRelease (key);
3053 }
3054
3055 SetMenuItemTextWithCFString (menu, pos, item_name);
3056 CFRelease (item_name);
3057
3058 if (wv->enabled)
3059 EnableMenuItem (menu, pos);
3060 else
3061 DisableMenuItem (menu, pos);
3062
3063 if (STRINGP (wv->help))
3064 SetMenuItemProperty (menu, pos, MAC_EMACS_CREATOR_CODE, 'help',
3065 sizeof (Lisp_Object), &wv->help);
3066 #else /* ! TARGET_API_MAC_CARBON */
3067 item_name[sizeof (item_name) - 1] = '\0';
3068 strncpy (item_name, wv->name, sizeof (item_name) - 1);
3069 if (wv->key != NULL)
3070 {
3071 int len = strlen (item_name);
3072
3073 strncpy (item_name + len, " ", sizeof (item_name) - 1 - len);
3074 len = strlen (item_name);
3075 strncpy (item_name + len, wv->key, sizeof (item_name) - 1 - len);
3076 }
3077 c2pstr (item_name);
3078 SetMenuItemText (menu, pos, item_name);
3079
3080 if (wv->enabled)
3081 EnableItem (menu, pos);
3082 else
3083 DisableItem (menu, pos);
3084 #endif /* ! TARGET_API_MAC_CARBON */
3085
3086 /* Draw radio buttons and tickboxes. */
3087 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
3088 wv->button_type == BUTTON_TYPE_RADIO))
3089 SetItemMark (menu, pos, checkMark);
3090 else
3091 SetItemMark (menu, pos, noMark);
3092
3093 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
3094 }
3095 }
3096
3097 /* Construct native Mac OS menu based on widget_value tree. */
3098
3099 static int
3100 fill_menu (menu, wv, kind, submenu_id)
3101 MenuHandle menu;
3102 widget_value *wv;
3103 enum mac_menu_kind kind;
3104 int submenu_id;
3105 {
3106 int pos;
3107
3108 for (pos = 1; wv != NULL; wv = wv->next, pos++)
3109 {
3110 add_menu_item (menu, pos, wv);
3111 if (wv->contents && submenu_id < min_menu_id[kind + 1])
3112 {
3113 MenuHandle submenu = NewMenu (submenu_id, "\pX");
3114
3115 InsertMenu (submenu, -1);
3116 SetMenuItemHierarchicalID (menu, pos, submenu_id);
3117 submenu_id = fill_menu (submenu, wv->contents, kind, submenu_id + 1);
3118 }
3119 }
3120
3121 return submenu_id;
3122 }
3123
3124 /* Construct native Mac OS menubar based on widget_value tree. */
3125
3126 static void
3127 fill_menubar (wv, deep_p)
3128 widget_value *wv;
3129 int deep_p;
3130 {
3131 int id, submenu_id;
3132 MenuHandle menu;
3133 Str255 title;
3134 #if !TARGET_API_MAC_CARBON
3135 int title_changed_p = 0;
3136 #endif
3137
3138 /* Clean up the menu bar when filled by the entire menu trees. */
3139 if (deep_p)
3140 {
3141 dispose_menus (MAC_MENU_MENU_BAR, 0);
3142 dispose_menus (MAC_MENU_MENU_BAR_SUB, 0);
3143 #if !TARGET_API_MAC_CARBON
3144 title_changed_p = 1;
3145 #endif
3146 }
3147
3148 /* Fill menu bar titles and submenus. Reuse the existing menu bar
3149 titles as much as possible to minimize redraw (if !deep_p). */
3150 submenu_id = min_menu_id[MAC_MENU_MENU_BAR_SUB];
3151 for (id = min_menu_id[MAC_MENU_MENU_BAR];
3152 wv != NULL && id < min_menu_id[MAC_MENU_MENU_BAR + 1];
3153 wv = wv->next, id++)
3154 {
3155 strncpy (title, wv->name, 255);
3156 title[255] = '\0';
3157 c2pstr (title);
3158
3159 menu = GetMenuHandle (id);
3160 if (menu)
3161 {
3162 #if TARGET_API_MAC_CARBON
3163 Str255 old_title;
3164
3165 GetMenuTitle (menu, old_title);
3166 if (!EqualString (title, old_title, false, false))
3167 SetMenuTitle (menu, title);
3168 #else /* !TARGET_API_MAC_CARBON */
3169 if (!EqualString (title, (*menu)->menuData, false, false))
3170 {
3171 DeleteMenu (id);
3172 DisposeMenu (menu);
3173 menu = NewMenu (id, title);
3174 InsertMenu (menu, GetMenuHandle (id + 1) ? id + 1 : 0);
3175 title_changed_p = 1;
3176 }
3177 #endif /* !TARGET_API_MAC_CARBON */
3178 }
3179 else
3180 {
3181 menu = NewMenu (id, title);
3182 InsertMenu (menu, 0);
3183 #if !TARGET_API_MAC_CARBON
3184 title_changed_p = 1;
3185 #endif
3186 }
3187
3188 if (wv->contents)
3189 submenu_id = fill_menu (menu, wv->contents, MAC_MENU_MENU_BAR_SUB,
3190 submenu_id);
3191 }
3192
3193 if (id < min_menu_id[MAC_MENU_MENU_BAR + 1] && GetMenuHandle (id))
3194 {
3195 dispose_menus (MAC_MENU_MENU_BAR, id);
3196 #if !TARGET_API_MAC_CARBON
3197 title_changed_p = 1;
3198 #endif
3199 }
3200
3201 #if !TARGET_API_MAC_CARBON
3202 if (title_changed_p)
3203 InvalMenuBar ();
3204 #endif
3205 }
3206
3207 /* Dispose of menus that belong to KIND, and remove them from the menu
3208 list. ID is the lower bound of menu IDs that will be processed. */
3209
3210 static void
3211 dispose_menus (kind, id)
3212 enum mac_menu_kind kind;
3213 int id;
3214 {
3215 for (id = max (id, min_menu_id[kind]); id < min_menu_id[kind + 1]; id++)
3216 {
3217 MenuHandle menu = GetMenuHandle (id);
3218
3219 if (menu == NULL)
3220 break;
3221 DeleteMenu (id);
3222 DisposeMenu (menu);
3223 }
3224 }
3225
3226 #endif /* HAVE_MENUS */
3227
3228 /* Detect if a menu is currently active. */
3229
3230 int
3231 popup_activated ()
3232 {
3233 return popup_activated_flag;
3234 }
3235
3236 /* The following is used by delayed window autoselection. */
3237
3238 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
3239 doc: /* Return t if a menu or popup dialog is active. */)
3240 ()
3241 {
3242 /* Always return Qnil since menu selection functions do not return
3243 until a selection has been made or cancelled. */
3244 return Qnil;
3245 }
3246 \f
3247 void
3248 syms_of_macmenu ()
3249 {
3250 staticpro (&menu_items);
3251 menu_items = Qnil;
3252
3253 Qdebug_on_next_call = intern ("debug-on-next-call");
3254 staticpro (&Qdebug_on_next_call);
3255
3256 defsubr (&Sx_popup_menu);
3257 defsubr (&Smenu_or_popup_active_p);
3258 #ifdef HAVE_MENUS
3259 defsubr (&Sx_popup_dialog);
3260 #endif
3261 }
3262
3263 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
3264 (do not change this comment) */