Merge from emacs--rel--22
[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_ ((MenuRef, 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 /* Force a redisplay before showing the dialog. If a frame is
1015 created just before showing the dialog, its contents may not
1016 have been fully drawn. */
1017 Fredisplay (Qt);
1018
1019 tem = Fstring_match (concat3 (build_string ("\\("),
1020 call0 (intern ("sentence-end")),
1021 build_string ("\\)\n")),
1022 XCAR (contents), Qnil);
1023 BLOCK_INPUT;
1024 if (NILP (tem))
1025 {
1026 error_string = cfstring_create_with_string (XCAR (contents));
1027 if (error_string == NULL)
1028 err = memFullErr;
1029 explanation_string = NULL;
1030 }
1031 else
1032 {
1033 tem = Fmatch_end (make_number (1));
1034 error_string =
1035 cfstring_create_with_string (Fsubstring (XCAR (contents),
1036 make_number (0), tem));
1037 if (error_string == NULL)
1038 err = memFullErr;
1039 else
1040 {
1041 XSETINT (tem, XINT (tem) + 1);
1042 explanation_string =
1043 cfstring_create_with_string (Fsubstring (XCAR (contents),
1044 tem, Qnil));
1045 if (explanation_string == NULL)
1046 {
1047 CFRelease (error_string);
1048 err = memFullErr;
1049 }
1050 }
1051 }
1052 if (err == noErr)
1053 err = GetStandardAlertDefaultParams (&param,
1054 kStdCFStringAlertVersionOne);
1055 if (err == noErr)
1056 {
1057 param.movable = true;
1058 param.position = kWindowAlertPositionParentWindow;
1059 if (NILP (header))
1060 {
1061 param.defaultText = CFSTR ("Yes");
1062 param.otherText = CFSTR ("No");
1063 #if 0
1064 param.cancelText = CFSTR ("Cancel");
1065 param.cancelButton = kAlertStdAlertCancelButton;
1066 #endif
1067 }
1068 err = CreateStandardAlert (kAlertNoteAlert, error_string,
1069 explanation_string, &param, &alert);
1070 CFRelease (error_string);
1071 if (explanation_string)
1072 CFRelease (explanation_string);
1073 }
1074 if (err == noErr)
1075 err = RunStandardAlert (alert, mac_dialog_modal_filter, &item_hit);
1076 UNBLOCK_INPUT;
1077
1078 if (err == noErr)
1079 {
1080 if (item_hit == kStdCancelItemIndex)
1081 Fsignal (Qquit, Qnil);
1082 else if (item_hit == kStdOkItemIndex)
1083 return Qt;
1084 else
1085 return Qnil;
1086 }
1087 }
1088 #endif
1089 #ifndef HAVE_DIALOGS
1090 /* Display a menu with these alternatives
1091 in the middle of frame F. */
1092 {
1093 Lisp_Object x, y, frame, newpos;
1094 XSETFRAME (frame, f);
1095 XSETINT (x, x_pixel_width (f) / 2);
1096 XSETINT (y, x_pixel_height (f) / 2);
1097 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1098
1099 return Fx_popup_menu (newpos,
1100 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1101 }
1102 #else /* HAVE_DIALOGS */
1103 {
1104 Lisp_Object title;
1105 char *error_name;
1106 Lisp_Object selection;
1107 int specpdl_count = SPECPDL_INDEX ();
1108
1109 /* Decode the dialog items from what was specified. */
1110 title = Fcar (contents);
1111 CHECK_STRING (title);
1112
1113 list_of_panes (Fcons (contents, Qnil));
1114
1115 /* Display them in a dialog box. */
1116 record_unwind_protect (cleanup_popup_menu, Qnil);
1117 BLOCK_INPUT;
1118 selection = mac_dialog_show (f, 0, title, header, &error_name);
1119 UNBLOCK_INPUT;
1120 unbind_to (specpdl_count, Qnil);
1121
1122 if (error_name) error (error_name);
1123 return selection;
1124 }
1125 #endif /* HAVE_DIALOGS */
1126 }
1127
1128 /* Activate the menu bar of frame F.
1129 This is called from keyboard.c when it gets the
1130 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1131
1132 To activate the menu bar, we use the button-press event location
1133 that was saved in saved_menu_event_location.
1134
1135 But first we recompute the menu bar contents (the whole tree).
1136
1137 The reason for saving the button event until here, instead of
1138 passing it to the toolkit right away, is that we can safely
1139 execute Lisp code. */
1140
1141 void
1142 x_activate_menubar (f)
1143 FRAME_PTR f;
1144 {
1145 SInt32 menu_choice;
1146 SInt16 menu_id, menu_item;
1147 extern Point saved_menu_event_location;
1148
1149 set_frame_menubar (f, 0, 1);
1150 BLOCK_INPUT;
1151
1152 popup_activated_flag = 1;
1153 menu_choice = MenuSelect (saved_menu_event_location);
1154 popup_activated_flag = 0;
1155 menu_id = HiWord (menu_choice);
1156 menu_item = LoWord (menu_choice);
1157
1158 #if !TARGET_API_MAC_CARBON
1159 if (menu_id == min_menu_id[MAC_MENU_M_APPLE])
1160 do_apple_menu (menu_item);
1161 else
1162 #endif
1163 if (menu_id)
1164 {
1165 MenuRef menu = GetMenuRef (menu_id);
1166
1167 if (menu)
1168 {
1169 UInt32 refcon;
1170
1171 GetMenuItemRefCon (menu, menu_item, &refcon);
1172 find_and_call_menu_selection (f, f->menu_bar_items_used,
1173 f->menu_bar_vector, (void *) refcon);
1174 }
1175 }
1176
1177 HiliteMenu (0);
1178
1179 UNBLOCK_INPUT;
1180 }
1181
1182 /* Find the menu selection and store it in the keyboard buffer.
1183 F is the frame the menu is on.
1184 MENU_BAR_ITEMS_USED is the length of VECTOR.
1185 VECTOR is an array of menu events for the whole menu. */
1186
1187 static void
1188 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
1189 FRAME_PTR f;
1190 int menu_bar_items_used;
1191 Lisp_Object vector;
1192 void *client_data;
1193 {
1194 Lisp_Object prefix, entry;
1195 Lisp_Object *subprefix_stack;
1196 int submenu_depth = 0;
1197 int i;
1198
1199 entry = Qnil;
1200 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
1201 prefix = Qnil;
1202 i = 0;
1203
1204 while (i < menu_bar_items_used)
1205 {
1206 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1207 {
1208 subprefix_stack[submenu_depth++] = prefix;
1209 prefix = entry;
1210 i++;
1211 }
1212 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1213 {
1214 prefix = subprefix_stack[--submenu_depth];
1215 i++;
1216 }
1217 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1218 {
1219 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1220 i += MENU_ITEMS_PANE_LENGTH;
1221 }
1222 else
1223 {
1224 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1225 /* The EMACS_INT cast avoids a warning. There's no problem
1226 as long as pointers have enough bits to hold small integers. */
1227 if ((int) (EMACS_INT) client_data == i)
1228 {
1229 int j;
1230 struct input_event buf;
1231 Lisp_Object frame;
1232 EVENT_INIT (buf);
1233
1234 XSETFRAME (frame, f);
1235 buf.kind = MENU_BAR_EVENT;
1236 buf.frame_or_window = frame;
1237 buf.arg = frame;
1238 kbd_buffer_store_event (&buf);
1239
1240 for (j = 0; j < submenu_depth; j++)
1241 if (!NILP (subprefix_stack[j]))
1242 {
1243 buf.kind = MENU_BAR_EVENT;
1244 buf.frame_or_window = frame;
1245 buf.arg = subprefix_stack[j];
1246 kbd_buffer_store_event (&buf);
1247 }
1248
1249 if (!NILP (prefix))
1250 {
1251 buf.kind = MENU_BAR_EVENT;
1252 buf.frame_or_window = frame;
1253 buf.arg = prefix;
1254 kbd_buffer_store_event (&buf);
1255 }
1256
1257 buf.kind = MENU_BAR_EVENT;
1258 buf.frame_or_window = frame;
1259 buf.arg = entry;
1260 kbd_buffer_store_event (&buf);
1261
1262 return;
1263 }
1264 i += MENU_ITEMS_ITEM_LENGTH;
1265 }
1266 }
1267 }
1268
1269 /* Allocate a widget_value, blocking input. */
1270
1271 widget_value *
1272 xmalloc_widget_value ()
1273 {
1274 widget_value *value;
1275
1276 BLOCK_INPUT;
1277 value = malloc_widget_value ();
1278 UNBLOCK_INPUT;
1279
1280 return value;
1281 }
1282
1283 /* This recursively calls free_widget_value on the tree of widgets.
1284 It must free all data that was malloc'ed for these widget_values.
1285 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1286 must be left alone. */
1287
1288 void
1289 free_menubar_widget_value_tree (wv)
1290 widget_value *wv;
1291 {
1292 if (! wv) return;
1293
1294 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1295
1296 if (wv->contents && (wv->contents != (widget_value*)1))
1297 {
1298 free_menubar_widget_value_tree (wv->contents);
1299 wv->contents = (widget_value *) 0xDEADBEEF;
1300 }
1301 if (wv->next)
1302 {
1303 free_menubar_widget_value_tree (wv->next);
1304 wv->next = (widget_value *) 0xDEADBEEF;
1305 }
1306 BLOCK_INPUT;
1307 free_widget_value (wv);
1308 UNBLOCK_INPUT;
1309 }
1310 \f
1311 /* Set up data in menu_items for a menu bar item
1312 whose event type is ITEM_KEY (with string ITEM_NAME)
1313 and whose contents come from the list of keymaps MAPS. */
1314
1315 static int
1316 parse_single_submenu (item_key, item_name, maps)
1317 Lisp_Object item_key, item_name, maps;
1318 {
1319 Lisp_Object length;
1320 int len;
1321 Lisp_Object *mapvec;
1322 int i;
1323 int top_level_items = 0;
1324
1325 length = Flength (maps);
1326 len = XINT (length);
1327
1328 /* Convert the list MAPS into a vector MAPVEC. */
1329 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1330 for (i = 0; i < len; i++)
1331 {
1332 mapvec[i] = Fcar (maps);
1333 maps = Fcdr (maps);
1334 }
1335
1336 /* Loop over the given keymaps, making a pane for each map.
1337 But don't make a pane that is empty--ignore that map instead. */
1338 for (i = 0; i < len; i++)
1339 {
1340 if (!KEYMAPP (mapvec[i]))
1341 {
1342 /* Here we have a command at top level in the menu bar
1343 as opposed to a submenu. */
1344 top_level_items = 1;
1345 push_menu_pane (Qnil, Qnil);
1346 push_menu_item (item_name, Qt, item_key, mapvec[i],
1347 Qnil, Qnil, Qnil, Qnil);
1348 }
1349 else
1350 {
1351 Lisp_Object prompt;
1352 prompt = Fkeymap_prompt (mapvec[i]);
1353 single_keymap_panes (mapvec[i],
1354 !NILP (prompt) ? prompt : item_name,
1355 item_key, 0, 10);
1356 }
1357 }
1358
1359 return top_level_items;
1360 }
1361
1362 /* Create a tree of widget_value objects
1363 representing the panes and items
1364 in menu_items starting at index START, up to index END. */
1365
1366 static widget_value *
1367 digest_single_submenu (start, end, top_level_items)
1368 int start, end, top_level_items;
1369 {
1370 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1371 int i;
1372 int submenu_depth = 0;
1373 widget_value **submenu_stack;
1374 int panes_seen = 0;
1375
1376 submenu_stack
1377 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1378 wv = xmalloc_widget_value ();
1379 wv->name = "menu";
1380 wv->value = 0;
1381 wv->enabled = 1;
1382 wv->button_type = BUTTON_TYPE_NONE;
1383 wv->help = Qnil;
1384 first_wv = wv;
1385 save_wv = 0;
1386 prev_wv = 0;
1387
1388 /* Loop over all panes and items made by the preceding call
1389 to parse_single_submenu and construct a tree of widget_value objects.
1390 Ignore the panes and items used by previous calls to
1391 digest_single_submenu, even though those are also in menu_items. */
1392 i = start;
1393 while (i < end)
1394 {
1395 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1396 {
1397 submenu_stack[submenu_depth++] = save_wv;
1398 save_wv = prev_wv;
1399 prev_wv = 0;
1400 i++;
1401 }
1402 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1403 {
1404 prev_wv = save_wv;
1405 save_wv = submenu_stack[--submenu_depth];
1406 i++;
1407 }
1408 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1409 && submenu_depth != 0)
1410 i += MENU_ITEMS_PANE_LENGTH;
1411 /* Ignore a nil in the item list.
1412 It's meaningful only for dialog boxes. */
1413 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1414 i += 1;
1415 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1416 {
1417 /* Create a new pane. */
1418 Lisp_Object pane_name, prefix;
1419 char *pane_string;
1420
1421 panes_seen++;
1422
1423 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1424 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1425
1426 #ifndef HAVE_MULTILINGUAL_MENU
1427 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1428 {
1429 pane_name = ENCODE_MENU_STRING (pane_name);
1430 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1431 }
1432 #endif
1433 pane_string = (NILP (pane_name)
1434 ? "" : (char *) SDATA (pane_name));
1435 /* If there is just one top-level pane, put all its items directly
1436 under the top-level menu. */
1437 if (menu_items_n_panes == 1)
1438 pane_string = "";
1439
1440 /* If the pane has a meaningful name,
1441 make the pane a top-level menu item
1442 with its items as a submenu beneath it. */
1443 if (strcmp (pane_string, ""))
1444 {
1445 wv = xmalloc_widget_value ();
1446 if (save_wv)
1447 save_wv->next = wv;
1448 else
1449 first_wv->contents = wv;
1450 wv->lname = pane_name;
1451 /* Set value to 1 so update_submenu_strings can handle '@' */
1452 wv->value = (char *)1;
1453 wv->enabled = 1;
1454 wv->button_type = BUTTON_TYPE_NONE;
1455 wv->help = Qnil;
1456 save_wv = wv;
1457 }
1458 else
1459 save_wv = first_wv;
1460
1461 prev_wv = 0;
1462 i += MENU_ITEMS_PANE_LENGTH;
1463 }
1464 else
1465 {
1466 /* Create a new item within current pane. */
1467 Lisp_Object item_name, enable, descrip, def, type, selected;
1468 Lisp_Object help;
1469
1470 /* All items should be contained in panes. */
1471 if (panes_seen == 0)
1472 abort ();
1473
1474 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1475 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1476 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1477 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1478 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1479 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1480 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1481
1482 #ifndef HAVE_MULTILINGUAL_MENU
1483 if (STRING_MULTIBYTE (item_name))
1484 {
1485 item_name = ENCODE_MENU_STRING (item_name);
1486 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1487 }
1488
1489 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1490 {
1491 descrip = ENCODE_MENU_STRING (descrip);
1492 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1493 }
1494 #endif /* not HAVE_MULTILINGUAL_MENU */
1495
1496 wv = xmalloc_widget_value ();
1497 if (prev_wv)
1498 prev_wv->next = wv;
1499 else
1500 save_wv->contents = wv;
1501
1502 wv->lname = item_name;
1503 if (!NILP (descrip))
1504 wv->lkey = descrip;
1505 wv->value = 0;
1506 /* The EMACS_INT cast avoids a warning. There's no problem
1507 as long as pointers have enough bits to hold small integers. */
1508 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1509 wv->enabled = !NILP (enable);
1510
1511 if (NILP (type))
1512 wv->button_type = BUTTON_TYPE_NONE;
1513 else if (EQ (type, QCradio))
1514 wv->button_type = BUTTON_TYPE_RADIO;
1515 else if (EQ (type, QCtoggle))
1516 wv->button_type = BUTTON_TYPE_TOGGLE;
1517 else
1518 abort ();
1519
1520 wv->selected = !NILP (selected);
1521 if (! STRINGP (help))
1522 help = Qnil;
1523
1524 wv->help = help;
1525
1526 prev_wv = wv;
1527
1528 i += MENU_ITEMS_ITEM_LENGTH;
1529 }
1530 }
1531
1532 /* If we have just one "menu item"
1533 that was originally a button, return it by itself. */
1534 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1535 {
1536 wv = first_wv->contents;
1537 free_widget_value (first_wv);
1538 return wv;
1539 }
1540
1541 return first_wv;
1542 }
1543
1544 /* Walk through the widget_value tree starting at FIRST_WV and update
1545 the char * pointers from the corresponding lisp values.
1546 We do this after building the whole tree, since GC may happen while the
1547 tree is constructed, and small strings are relocated. So we must wait
1548 until no GC can happen before storing pointers into lisp values. */
1549 static void
1550 update_submenu_strings (first_wv)
1551 widget_value *first_wv;
1552 {
1553 widget_value *wv;
1554
1555 for (wv = first_wv; wv; wv = wv->next)
1556 {
1557 if (STRINGP (wv->lname))
1558 {
1559 wv->name = SDATA (wv->lname);
1560
1561 /* Ignore the @ that means "separate pane".
1562 This is a kludge, but this isn't worth more time. */
1563 if (wv->value == (char *)1)
1564 {
1565 if (wv->name[0] == '@')
1566 wv->name++;
1567 wv->value = 0;
1568 }
1569 }
1570
1571 if (STRINGP (wv->lkey))
1572 wv->key = SDATA (wv->lkey);
1573
1574 if (wv->contents)
1575 update_submenu_strings (wv->contents);
1576 }
1577 }
1578
1579 \f
1580 #if TARGET_API_MAC_CARBON
1581 extern Lisp_Object Vshow_help_function;
1582
1583 static Lisp_Object
1584 restore_show_help_function (old_show_help_function)
1585 Lisp_Object old_show_help_function;
1586 {
1587 Vshow_help_function = old_show_help_function;
1588
1589 return Qnil;
1590 }
1591
1592 static pascal OSStatus
1593 menu_target_item_handler (next_handler, event, data)
1594 EventHandlerCallRef next_handler;
1595 EventRef event;
1596 void *data;
1597 {
1598 OSStatus err;
1599 MenuRef menu;
1600 MenuItemIndex menu_item;
1601 Lisp_Object help;
1602 GrafPtr port;
1603 int specpdl_count = SPECPDL_INDEX ();
1604
1605 err = GetEventParameter (event, kEventParamDirectObject, typeMenuRef,
1606 NULL, sizeof (MenuRef), NULL, &menu);
1607 if (err == noErr)
1608 err = GetEventParameter (event, kEventParamMenuItemIndex,
1609 typeMenuItemIndex, NULL,
1610 sizeof (MenuItemIndex), NULL, &menu_item);
1611 if (err == noErr)
1612 err = GetMenuItemProperty (menu, menu_item,
1613 MAC_EMACS_CREATOR_CODE, 'help',
1614 sizeof (Lisp_Object), NULL, &help);
1615 if (err != noErr)
1616 help = Qnil;
1617
1618 /* Temporarily bind Vshow_help_function to Qnil because we don't
1619 want tooltips during menu tracking. */
1620 record_unwind_protect (restore_show_help_function, Vshow_help_function);
1621 Vshow_help_function = Qnil;
1622 GetPort (&port);
1623 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1624 SetPort (port);
1625 unbind_to (specpdl_count, Qnil);
1626
1627 return err == noErr ? noErr : eventNotHandledErr;
1628 }
1629
1630 OSStatus
1631 install_menu_target_item_handler ()
1632 {
1633 static const EventTypeSpec specs[] =
1634 {{kEventClassMenu, kEventMenuTargetItem}};
1635
1636 return InstallApplicationEventHandler (NewEventHandlerUPP
1637 (menu_target_item_handler),
1638 GetEventTypeCount (specs),
1639 specs, NULL, NULL);
1640 }
1641 #endif /* TARGET_API_MAC_CARBON */
1642
1643 /* Event handler function that pops down a menu on C-g. We can only pop
1644 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1645
1646 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1647 static pascal OSStatus
1648 menu_quit_handler (nextHandler, theEvent, userData)
1649 EventHandlerCallRef nextHandler;
1650 EventRef theEvent;
1651 void* userData;
1652 {
1653 OSStatus err;
1654 UInt32 keyCode;
1655 UInt32 keyModifiers;
1656
1657 err = GetEventParameter (theEvent, kEventParamKeyCode,
1658 typeUInt32, NULL, sizeof(UInt32), NULL, &keyCode);
1659
1660 if (err == noErr)
1661 err = GetEventParameter (theEvent, kEventParamKeyModifiers,
1662 typeUInt32, NULL, sizeof(UInt32),
1663 NULL, &keyModifiers);
1664
1665 if (err == noErr && mac_quit_char_key_p (keyModifiers, keyCode))
1666 {
1667 MenuRef menu = userData != 0
1668 ? (MenuRef)userData : AcquireRootMenu ();
1669
1670 CancelMenuTracking (menu, true, 0);
1671 if (!userData) ReleaseMenu (menu);
1672 return noErr;
1673 }
1674
1675 return CallNextEventHandler (nextHandler, theEvent);
1676 }
1677 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1678
1679 /* Add event handler to all menus that belong to KIND so we can detect
1680 C-g. ROOT_MENU is the root menu of the tracking session to dismiss
1681 when C-g is detected. NULL means the menu bar. If
1682 CancelMenuTracking isn't available, do nothing. */
1683
1684 static void
1685 install_menu_quit_handler (kind, root_menu)
1686 enum mac_menu_kind kind;
1687 MenuRef root_menu;
1688 {
1689 #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030
1690 static const EventTypeSpec typesList[] =
1691 {{kEventClassKeyboard, kEventRawKeyDown}};
1692 int id;
1693
1694 #if MAC_OS_X_VERSION_MIN_REQUIRED == 1020
1695 if (CancelMenuTracking == NULL)
1696 return;
1697 #endif
1698 for (id = min_menu_id[kind]; id < min_menu_id[kind + 1]; id++)
1699 {
1700 MenuRef menu = GetMenuRef (id);
1701
1702 if (menu == NULL)
1703 break;
1704 InstallMenuEventHandler (menu, menu_quit_handler,
1705 GetEventTypeCount (typesList),
1706 typesList, root_menu, NULL);
1707 }
1708 #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 */
1709 }
1710
1711 /* Set the contents of the menubar widgets of frame F.
1712 The argument FIRST_TIME is currently ignored;
1713 it is set the first time this is called, from initialize_frame_menubar. */
1714
1715 void
1716 set_frame_menubar (f, first_time, deep_p)
1717 FRAME_PTR f;
1718 int first_time;
1719 int deep_p;
1720 {
1721 int menubar_widget = f->output_data.mac->menubar_widget;
1722 Lisp_Object items;
1723 widget_value *wv, *first_wv, *prev_wv = 0;
1724 int i, last_i = 0;
1725 int *submenu_start, *submenu_end;
1726 int *submenu_top_level_items, *submenu_n_panes;
1727
1728 XSETFRAME (Vmenu_updating_frame, f);
1729
1730 /* This seems to be unnecessary for Carbon. */
1731 #if 0
1732 if (! menubar_widget)
1733 deep_p = 1;
1734 else if (pending_menu_activation && !deep_p)
1735 deep_p = 1;
1736 #endif
1737
1738 if (deep_p)
1739 {
1740 /* Make a widget-value tree representing the entire menu trees. */
1741
1742 struct buffer *prev = current_buffer;
1743 Lisp_Object buffer;
1744 int specpdl_count = SPECPDL_INDEX ();
1745 int previous_menu_items_used = f->menu_bar_items_used;
1746 Lisp_Object *previous_items
1747 = (Lisp_Object *) alloca (previous_menu_items_used
1748 * sizeof (Lisp_Object));
1749
1750 /* If we are making a new widget, its contents are empty,
1751 do always reinitialize them. */
1752 if (! menubar_widget)
1753 previous_menu_items_used = 0;
1754
1755 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1756 specbind (Qinhibit_quit, Qt);
1757 /* Don't let the debugger step into this code
1758 because it is not reentrant. */
1759 specbind (Qdebug_on_next_call, Qnil);
1760
1761 record_unwind_save_match_data ();
1762 if (NILP (Voverriding_local_map_menu_flag))
1763 {
1764 specbind (Qoverriding_terminal_local_map, Qnil);
1765 specbind (Qoverriding_local_map, Qnil);
1766 }
1767
1768 set_buffer_internal_1 (XBUFFER (buffer));
1769
1770 /* Run the Lucid hook. */
1771 safe_run_hooks (Qactivate_menubar_hook);
1772
1773 /* If it has changed current-menubar from previous value,
1774 really recompute the menubar from the value. */
1775 if (! NILP (Vlucid_menu_bar_dirty_flag))
1776 call0 (Qrecompute_lucid_menubar);
1777 safe_run_hooks (Qmenu_bar_update_hook);
1778 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1779
1780 items = FRAME_MENU_BAR_ITEMS (f);
1781
1782 /* Save the frame's previous menu bar contents data. */
1783 if (previous_menu_items_used)
1784 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1785 previous_menu_items_used * sizeof (Lisp_Object));
1786
1787 /* Fill in menu_items with the current menu bar contents.
1788 This can evaluate Lisp code. */
1789 save_menu_items ();
1790
1791 menu_items = f->menu_bar_vector;
1792 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1793 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1794 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1795 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1796 submenu_top_level_items
1797 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1798 init_menu_items ();
1799 for (i = 0; i < XVECTOR (items)->size; i += 4)
1800 {
1801 Lisp_Object key, string, maps;
1802
1803 last_i = i;
1804
1805 key = XVECTOR (items)->contents[i];
1806 string = XVECTOR (items)->contents[i + 1];
1807 maps = XVECTOR (items)->contents[i + 2];
1808 if (NILP (string))
1809 break;
1810
1811 submenu_start[i] = menu_items_used;
1812
1813 menu_items_n_panes = 0;
1814 submenu_top_level_items[i]
1815 = parse_single_submenu (key, string, maps);
1816 submenu_n_panes[i] = menu_items_n_panes;
1817
1818 submenu_end[i] = menu_items_used;
1819 }
1820
1821 finish_menu_items ();
1822
1823 /* Convert menu_items into widget_value trees
1824 to display the menu. This cannot evaluate Lisp code. */
1825
1826 wv = xmalloc_widget_value ();
1827 wv->name = "menubar";
1828 wv->value = 0;
1829 wv->enabled = 1;
1830 wv->button_type = BUTTON_TYPE_NONE;
1831 wv->help = Qnil;
1832 first_wv = wv;
1833
1834 for (i = 0; i < last_i; i += 4)
1835 {
1836 menu_items_n_panes = submenu_n_panes[i];
1837 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1838 submenu_top_level_items[i]);
1839 if (prev_wv)
1840 prev_wv->next = wv;
1841 else
1842 first_wv->contents = wv;
1843 /* Don't set wv->name here; GC during the loop might relocate it. */
1844 wv->enabled = 1;
1845 wv->button_type = BUTTON_TYPE_NONE;
1846 prev_wv = wv;
1847 }
1848
1849 set_buffer_internal_1 (prev);
1850
1851 /* If there has been no change in the Lisp-level contents
1852 of the menu bar, skip redisplaying it. Just exit. */
1853
1854 /* Compare the new menu items with the ones computed last time. */
1855 for (i = 0; i < previous_menu_items_used; i++)
1856 if (menu_items_used == i
1857 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1858 break;
1859 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1860 {
1861 /* The menu items have not changed. Don't bother updating
1862 the menus in any form, since it would be a no-op. */
1863 free_menubar_widget_value_tree (first_wv);
1864 discard_menu_items ();
1865 unbind_to (specpdl_count, Qnil);
1866 return;
1867 }
1868
1869 /* The menu items are different, so store them in the frame. */
1870 f->menu_bar_vector = menu_items;
1871 f->menu_bar_items_used = menu_items_used;
1872
1873 /* This calls restore_menu_items to restore menu_items, etc.,
1874 as they were outside. */
1875 unbind_to (specpdl_count, Qnil);
1876
1877 /* Now GC cannot happen during the lifetime of the widget_value,
1878 so it's safe to store data from a Lisp_String. */
1879 wv = first_wv->contents;
1880 for (i = 0; i < XVECTOR (items)->size; i += 4)
1881 {
1882 Lisp_Object string;
1883 string = XVECTOR (items)->contents[i + 1];
1884 if (NILP (string))
1885 break;
1886 wv->name = (char *) SDATA (string);
1887 update_submenu_strings (wv->contents);
1888 wv = wv->next;
1889 }
1890
1891 }
1892 else
1893 {
1894 /* Make a widget-value tree containing
1895 just the top level menu bar strings. */
1896
1897 wv = xmalloc_widget_value ();
1898 wv->name = "menubar";
1899 wv->value = 0;
1900 wv->enabled = 1;
1901 wv->button_type = BUTTON_TYPE_NONE;
1902 wv->help = Qnil;
1903 first_wv = wv;
1904
1905 items = FRAME_MENU_BAR_ITEMS (f);
1906 for (i = 0; i < XVECTOR (items)->size; i += 4)
1907 {
1908 Lisp_Object string;
1909
1910 string = XVECTOR (items)->contents[i + 1];
1911 if (NILP (string))
1912 break;
1913
1914 wv = xmalloc_widget_value ();
1915 wv->name = (char *) SDATA (string);
1916 wv->value = 0;
1917 wv->enabled = 1;
1918 wv->button_type = BUTTON_TYPE_NONE;
1919 wv->help = Qnil;
1920 /* This prevents lwlib from assuming this
1921 menu item is really supposed to be empty. */
1922 /* The EMACS_INT cast avoids a warning.
1923 This value just has to be different from small integers. */
1924 wv->call_data = (void *) (EMACS_INT) (-1);
1925
1926 if (prev_wv)
1927 prev_wv->next = wv;
1928 else
1929 first_wv->contents = wv;
1930 prev_wv = wv;
1931 }
1932
1933 /* Forget what we thought we knew about what is in the
1934 detailed contents of the menu bar menus.
1935 Changing the top level always destroys the contents. */
1936 f->menu_bar_items_used = 0;
1937 }
1938
1939 /* Create or update the menu bar widget. */
1940
1941 BLOCK_INPUT;
1942
1943 /* Non-null value to indicate menubar has already been "created". */
1944 f->output_data.mac->menubar_widget = 1;
1945
1946 fill_menubar (first_wv->contents, deep_p);
1947
1948 /* Add event handler so we can detect C-g. */
1949 install_menu_quit_handler (MAC_MENU_MENU_BAR, NULL);
1950 install_menu_quit_handler (MAC_MENU_MENU_BAR_SUB, NULL);
1951 free_menubar_widget_value_tree (first_wv);
1952
1953 UNBLOCK_INPUT;
1954 }
1955
1956 /* Get rid of the menu bar of frame F, and free its storage.
1957 This is used when deleting a frame, and when turning off the menu bar. */
1958
1959 void
1960 free_frame_menubar (f)
1961 FRAME_PTR f;
1962 {
1963 f->output_data.mac->menubar_widget = 0;
1964 }
1965
1966 \f
1967 static Lisp_Object
1968 pop_down_menu (arg)
1969 Lisp_Object arg;
1970 {
1971 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
1972 FRAME_PTR f = p->pointer;
1973 MenuRef menu = GetMenuRef (min_menu_id[MAC_MENU_POPUP]);
1974
1975 BLOCK_INPUT;
1976
1977 /* Must reset this manually because the button release event is not
1978 passed to Emacs event loop. */
1979 FRAME_MAC_DISPLAY_INFO (f)->grabbed = 0;
1980
1981 /* delete all menus */
1982 dispose_menus (MAC_MENU_POPUP_SUB, 0);
1983 DeleteMenu (min_menu_id[MAC_MENU_POPUP]);
1984 DisposeMenu (menu);
1985
1986 UNBLOCK_INPUT;
1987
1988 return Qnil;
1989 }
1990
1991 /* Mac_menu_show actually displays a menu using the panes and items in
1992 menu_items and returns the value selected from it; we assume input
1993 is blocked by the caller. */
1994
1995 /* F is the frame the menu is for.
1996 X and Y are the frame-relative specified position,
1997 relative to the inside upper left corner of the frame F.
1998 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1999 KEYMAPS is 1 if this menu was specified with keymaps;
2000 in that case, we return a list containing the chosen item's value
2001 and perhaps also the pane's prefix.
2002 TITLE is the specified menu title.
2003 ERROR is a place to store an error message string in case of failure.
2004 (We return nil on failure, but the value doesn't actually matter.) */
2005
2006 static Lisp_Object
2007 mac_menu_show (f, x, y, for_click, keymaps, title, error)
2008 FRAME_PTR f;
2009 int x;
2010 int y;
2011 int for_click;
2012 int keymaps;
2013 Lisp_Object title;
2014 char **error;
2015 {
2016 int i;
2017 int menu_item_choice;
2018 UInt32 menu_item_selection;
2019 MenuRef menu;
2020 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2021 widget_value **submenu_stack
2022 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
2023 Lisp_Object *subprefix_stack
2024 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
2025 int submenu_depth = 0;
2026
2027 int first_pane;
2028 int specpdl_count = SPECPDL_INDEX ();
2029
2030 *error = NULL;
2031
2032 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2033 {
2034 *error = "Empty menu";
2035 return Qnil;
2036 }
2037
2038 /* Create a tree of widget_value objects
2039 representing the panes and their items. */
2040 wv = xmalloc_widget_value ();
2041 wv->name = "menu";
2042 wv->value = 0;
2043 wv->enabled = 1;
2044 wv->button_type = BUTTON_TYPE_NONE;
2045 wv->help = Qnil;
2046 first_wv = wv;
2047 first_pane = 1;
2048
2049 /* Loop over all panes and items, filling in the tree. */
2050 i = 0;
2051 while (i < menu_items_used)
2052 {
2053 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2054 {
2055 submenu_stack[submenu_depth++] = save_wv;
2056 save_wv = prev_wv;
2057 prev_wv = 0;
2058 first_pane = 1;
2059 i++;
2060 }
2061 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2062 {
2063 prev_wv = save_wv;
2064 save_wv = submenu_stack[--submenu_depth];
2065 first_pane = 0;
2066 i++;
2067 }
2068 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2069 && submenu_depth != 0)
2070 i += MENU_ITEMS_PANE_LENGTH;
2071 /* Ignore a nil in the item list.
2072 It's meaningful only for dialog boxes. */
2073 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2074 i += 1;
2075 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2076 {
2077 /* Create a new pane. */
2078 Lisp_Object pane_name, prefix;
2079 char *pane_string;
2080
2081 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2082 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2083
2084 #ifndef HAVE_MULTILINGUAL_MENU
2085 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2086 {
2087 pane_name = ENCODE_MENU_STRING (pane_name);
2088 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2089 }
2090 #endif
2091 pane_string = (NILP (pane_name)
2092 ? "" : (char *) SDATA (pane_name));
2093 /* If there is just one top-level pane, put all its items directly
2094 under the top-level menu. */
2095 if (menu_items_n_panes == 1)
2096 pane_string = "";
2097
2098 /* If the pane has a meaningful name,
2099 make the pane a top-level menu item
2100 with its items as a submenu beneath it. */
2101 if (!keymaps && strcmp (pane_string, ""))
2102 {
2103 wv = xmalloc_widget_value ();
2104 if (save_wv)
2105 save_wv->next = wv;
2106 else
2107 first_wv->contents = wv;
2108 wv->name = pane_string;
2109 if (keymaps && !NILP (prefix))
2110 wv->name++;
2111 wv->value = 0;
2112 wv->enabled = 1;
2113 wv->button_type = BUTTON_TYPE_NONE;
2114 wv->help = Qnil;
2115 save_wv = wv;
2116 prev_wv = 0;
2117 }
2118 else if (first_pane)
2119 {
2120 save_wv = wv;
2121 prev_wv = 0;
2122 }
2123 first_pane = 0;
2124 i += MENU_ITEMS_PANE_LENGTH;
2125 }
2126 else
2127 {
2128 /* Create a new item within current pane. */
2129 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2130 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2131 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2132 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2133 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2134 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2135 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2136 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2137
2138 #ifndef HAVE_MULTILINGUAL_MENU
2139 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2140 {
2141 item_name = ENCODE_MENU_STRING (item_name);
2142 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2143 }
2144
2145 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2146 {
2147 descrip = ENCODE_MENU_STRING (descrip);
2148 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2149 }
2150 #endif /* not HAVE_MULTILINGUAL_MENU */
2151
2152 wv = xmalloc_widget_value ();
2153 if (prev_wv)
2154 prev_wv->next = wv;
2155 else
2156 save_wv->contents = wv;
2157 wv->name = (char *) SDATA (item_name);
2158 if (!NILP (descrip))
2159 wv->key = (char *) SDATA (descrip);
2160 wv->value = 0;
2161 /* Use the contents index as call_data, since we are
2162 restricted to 16-bits. */
2163 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
2164 wv->enabled = !NILP (enable);
2165
2166 if (NILP (type))
2167 wv->button_type = BUTTON_TYPE_NONE;
2168 else if (EQ (type, QCtoggle))
2169 wv->button_type = BUTTON_TYPE_TOGGLE;
2170 else if (EQ (type, QCradio))
2171 wv->button_type = BUTTON_TYPE_RADIO;
2172 else
2173 abort ();
2174
2175 wv->selected = !NILP (selected);
2176
2177 if (! STRINGP (help))
2178 help = Qnil;
2179
2180 wv->help = help;
2181
2182 prev_wv = wv;
2183
2184 i += MENU_ITEMS_ITEM_LENGTH;
2185 }
2186 }
2187
2188 /* Deal with the title, if it is non-nil. */
2189 if (!NILP (title))
2190 {
2191 widget_value *wv_title = xmalloc_widget_value ();
2192 widget_value *wv_sep = xmalloc_widget_value ();
2193
2194 /* Maybe replace this separator with a bitmap or owner-draw item
2195 so that it looks better. Having two separators looks odd. */
2196 wv_sep->name = "--";
2197 wv_sep->next = first_wv->contents;
2198 wv_sep->help = Qnil;
2199
2200 #ifndef HAVE_MULTILINGUAL_MENU
2201 if (STRING_MULTIBYTE (title))
2202 title = ENCODE_MENU_STRING (title);
2203 #endif
2204
2205 wv_title->name = (char *) SDATA (title);
2206 wv_title->enabled = FALSE;
2207 wv_title->title = TRUE;
2208 wv_title->button_type = BUTTON_TYPE_NONE;
2209 wv_title->help = Qnil;
2210 wv_title->next = wv_sep;
2211 first_wv->contents = wv_title;
2212 }
2213
2214 /* Actually create the menu. */
2215 menu = NewMenu (min_menu_id[MAC_MENU_POPUP], "\p");
2216 InsertMenu (menu, -1);
2217 fill_menu (menu, first_wv->contents, MAC_MENU_POPUP_SUB,
2218 min_menu_id[MAC_MENU_POPUP_SUB]);
2219
2220 /* Free the widget_value objects we used to specify the
2221 contents. */
2222 free_menubar_widget_value_tree (first_wv);
2223
2224 /* Adjust coordinates to be root-window-relative. */
2225 x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2226 y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2227
2228 /* No selection has been chosen yet. */
2229 menu_item_selection = 0;
2230
2231 record_unwind_protect (pop_down_menu, make_save_value (f, 0));
2232
2233 /* Add event handler so we can detect C-g. */
2234 install_menu_quit_handler (MAC_MENU_POPUP, menu);
2235 install_menu_quit_handler (MAC_MENU_POPUP_SUB, menu);
2236
2237 /* Display the menu. */
2238 popup_activated_flag = 1;
2239 menu_item_choice = PopUpMenuSelect (menu, y, x, 0);
2240 popup_activated_flag = 0;
2241
2242 /* Get the refcon to find the correct item */
2243 if (menu_item_choice)
2244 {
2245 MenuRef sel_menu = GetMenuRef (HiWord (menu_item_choice));
2246
2247 if (sel_menu)
2248 GetMenuItemRefCon (sel_menu, LoWord (menu_item_choice),
2249 &menu_item_selection);
2250 }
2251
2252 unbind_to (specpdl_count, Qnil);
2253
2254 /* Find the selected item, and its pane, to return
2255 the proper value. */
2256 if (menu_item_selection != 0)
2257 {
2258 Lisp_Object prefix, entry;
2259
2260 prefix = entry = Qnil;
2261 i = 0;
2262 while (i < menu_items_used)
2263 {
2264 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2265 {
2266 subprefix_stack[submenu_depth++] = prefix;
2267 prefix = entry;
2268 i++;
2269 }
2270 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2271 {
2272 prefix = subprefix_stack[--submenu_depth];
2273 i++;
2274 }
2275 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2276 {
2277 prefix
2278 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2279 i += MENU_ITEMS_PANE_LENGTH;
2280 }
2281 /* Ignore a nil in the item list.
2282 It's meaningful only for dialog boxes. */
2283 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2284 i += 1;
2285 else
2286 {
2287 entry
2288 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2289 if (menu_item_selection == i)
2290 {
2291 if (keymaps != 0)
2292 {
2293 int j;
2294
2295 entry = Fcons (entry, Qnil);
2296 if (!NILP (prefix))
2297 entry = Fcons (prefix, entry);
2298 for (j = submenu_depth - 1; j >= 0; j--)
2299 if (!NILP (subprefix_stack[j]))
2300 entry = Fcons (subprefix_stack[j], entry);
2301 }
2302 return entry;
2303 }
2304 i += MENU_ITEMS_ITEM_LENGTH;
2305 }
2306 }
2307 }
2308 else if (!for_click)
2309 /* Make "Cancel" equivalent to C-g. */
2310 Fsignal (Qquit, Qnil);
2311
2312 return Qnil;
2313 }
2314 \f
2315
2316 #ifdef HAVE_DIALOGS
2317 /* Construct native Mac OS dialog based on widget_value tree. */
2318
2319 #if TARGET_API_MAC_CARBON
2320
2321 #define DIALOG_BUTTON_COMMAND_ID_OFFSET 'Bt\0\0'
2322 #define DIALOG_BUTTON_COMMAND_ID_P(id) \
2323 (((id) & ~0xffff) == DIALOG_BUTTON_COMMAND_ID_OFFSET)
2324 #define DIALOG_BUTTON_COMMAND_ID_VALUE(id) \
2325 ((id) - DIALOG_BUTTON_COMMAND_ID_OFFSET)
2326 #define DIALOG_BUTTON_MAKE_COMMAND_ID(value) \
2327 ((value) + DIALOG_BUTTON_COMMAND_ID_OFFSET)
2328
2329 static pascal OSStatus
2330 mac_handle_dialog_event (next_handler, event, data)
2331 EventHandlerCallRef next_handler;
2332 EventRef event;
2333 void *data;
2334 {
2335 OSStatus err;
2336 WindowRef window = (WindowRef) data;
2337
2338 switch (GetEventClass (event))
2339 {
2340 case kEventClassCommand:
2341 {
2342 HICommand command;
2343
2344 err = GetEventParameter (event, kEventParamDirectObject,
2345 typeHICommand, NULL, sizeof (HICommand),
2346 NULL, &command);
2347 if (err == noErr)
2348 if (DIALOG_BUTTON_COMMAND_ID_P (command.commandID))
2349 {
2350 SetWRefCon (window, command.commandID);
2351 err = QuitAppModalLoopForWindow (window);
2352
2353 return err == noErr ? noErr : eventNotHandledErr;
2354 }
2355
2356 return CallNextEventHandler (next_handler, event);
2357 }
2358 break;
2359
2360 case kEventClassKeyboard:
2361 {
2362 OSStatus result;
2363 char char_code;
2364
2365 result = CallNextEventHandler (next_handler, event);
2366 if (result == noErr)
2367 return noErr;
2368
2369 err = GetEventParameter (event, kEventParamKeyMacCharCodes,
2370 typeChar, NULL, sizeof (char),
2371 NULL, &char_code);
2372 if (err == noErr)
2373 switch (char_code)
2374 {
2375 case kEscapeCharCode:
2376 err = QuitAppModalLoopForWindow (window);
2377 break;
2378
2379 default:
2380 {
2381 UInt32 modifiers, key_code;
2382
2383 err = GetEventParameter (event, kEventParamKeyModifiers,
2384 typeUInt32, NULL, sizeof (UInt32),
2385 NULL, &modifiers);
2386 if (err == noErr)
2387 err = GetEventParameter (event, kEventParamKeyCode,
2388 typeUInt32, NULL, sizeof (UInt32),
2389 NULL, &key_code);
2390 if (err == noErr)
2391 {
2392 if (mac_quit_char_key_p (modifiers, key_code))
2393 err = QuitAppModalLoopForWindow (window);
2394 else
2395 err = eventNotHandledErr;
2396 }
2397 }
2398 break;
2399 }
2400
2401 if (err == noErr)
2402 result = noErr;
2403
2404 return result;
2405 }
2406 break;
2407
2408 default:
2409 abort ();
2410 }
2411 }
2412
2413 static OSStatus
2414 install_dialog_event_handler (window)
2415 WindowRef window;
2416 {
2417 static const EventTypeSpec specs[] =
2418 {{kEventClassCommand, kEventCommandProcess},
2419 {kEventClassKeyboard, kEventRawKeyDown}};
2420 static EventHandlerUPP handle_dialog_eventUPP = NULL;
2421
2422 if (handle_dialog_eventUPP == NULL)
2423 handle_dialog_eventUPP = NewEventHandlerUPP (mac_handle_dialog_event);
2424 return InstallWindowEventHandler (window, handle_dialog_eventUPP,
2425 GetEventTypeCount (specs), specs,
2426 window, NULL);
2427 }
2428
2429 #define DIALOG_LEFT_MARGIN (112)
2430 #define DIALOG_TOP_MARGIN (24)
2431 #define DIALOG_RIGHT_MARGIN (24)
2432 #define DIALOG_BOTTOM_MARGIN (20)
2433 #define DIALOG_MIN_INNER_WIDTH (338)
2434 #define DIALOG_MAX_INNER_WIDTH (564)
2435 #define DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE (12)
2436 #define DIALOG_BUTTON_BUTTON_VERTICAL_SPACE (12)
2437 #define DIALOG_BUTTON_MIN_WIDTH (68)
2438 #define DIALOG_TEXT_MIN_HEIGHT (50)
2439 #define DIALOG_TEXT_BUTTONS_VERTICAL_SPACE (10)
2440 #define DIALOG_ICON_WIDTH (64)
2441 #define DIALOG_ICON_HEIGHT (64)
2442 #define DIALOG_ICON_LEFT_MARGIN (24)
2443 #define DIALOG_ICON_TOP_MARGIN (15)
2444
2445 static int
2446 create_and_show_dialog (f, first_wv)
2447 FRAME_PTR f;
2448 widget_value *first_wv;
2449 {
2450 OSStatus err;
2451 char *dialog_name, *message;
2452 int nb_buttons, first_group_count, i, result = 0;
2453 widget_value *wv;
2454 short buttons_height, text_height, inner_width, inner_height;
2455 Rect empty_rect, *rects;
2456 WindowRef window = NULL;
2457 ControlRef *buttons, default_button = NULL, text;
2458
2459 dialog_name = first_wv->name;
2460 nb_buttons = dialog_name[1] - '0';
2461 first_group_count = nb_buttons - (dialog_name[4] - '0');
2462
2463 wv = first_wv->contents;
2464 message = wv->value;
2465
2466 wv = wv->next;
2467 SetRect (&empty_rect, 0, 0, 0, 0);
2468
2469 /* Create dialog window. */
2470 err = CreateNewWindow (kMovableModalWindowClass,
2471 kWindowStandardHandlerAttribute,
2472 &empty_rect, &window);
2473 if (err == noErr)
2474 err = SetThemeWindowBackground (window, kThemeBrushMovableModalBackground,
2475 true);
2476 if (err == noErr)
2477 err = SetWindowTitleWithCFString (window, (dialog_name[0] == 'Q'
2478 ? CFSTR ("Question")
2479 : CFSTR ("Information")));
2480
2481 /* Create button controls and measure their optimal bounds. */
2482 if (err == noErr)
2483 {
2484 buttons = alloca (sizeof (ControlRef) * nb_buttons);
2485 rects = alloca (sizeof (Rect) * nb_buttons);
2486 for (i = 0; i < nb_buttons; i++)
2487 {
2488 CFStringRef label = cfstring_create_with_utf8_cstring (wv->value);
2489
2490 if (label == NULL)
2491 err = memFullErr;
2492 else
2493 {
2494 err = CreatePushButtonControl (window, &empty_rect,
2495 label, &buttons[i]);
2496 CFRelease (label);
2497 }
2498 if (err == noErr)
2499 {
2500 if (!wv->enabled)
2501 {
2502 #ifdef MAC_OSX
2503 err = DisableControl (buttons[i]);
2504 #else
2505 err = DeactivateControl (buttons[i]);
2506 #endif
2507 }
2508 else if (default_button == NULL)
2509 default_button = buttons[i];
2510 }
2511 if (err == noErr)
2512 {
2513 SInt16 unused;
2514
2515 rects[i] = empty_rect;
2516 err = GetBestControlRect (buttons[i], &rects[i], &unused);
2517 }
2518 if (err == noErr)
2519 {
2520 UInt32 command_id;
2521
2522 OffsetRect (&rects[i], -rects[i].left, -rects[i].top);
2523 if (rects[i].right < DIALOG_BUTTON_MIN_WIDTH)
2524 rects[i].right = DIALOG_BUTTON_MIN_WIDTH;
2525 else if (rects[i].right > DIALOG_MAX_INNER_WIDTH)
2526 rects[i].right = DIALOG_MAX_INNER_WIDTH;
2527
2528 command_id = DIALOG_BUTTON_MAKE_COMMAND_ID ((int) wv->call_data);
2529 err = SetControlCommandID (buttons[i], command_id);
2530 }
2531 if (err != noErr)
2532 break;
2533 wv = wv->next;
2534 }
2535 }
2536
2537 /* Layout buttons. rects[i] is set relative to the bottom-right
2538 corner of the inner box. */
2539 if (err == noErr)
2540 {
2541 short bottom, right, max_height, left_align_shift;
2542
2543 inner_width = DIALOG_MIN_INNER_WIDTH;
2544 bottom = right = max_height = 0;
2545 for (i = 0; i < nb_buttons; i++)
2546 {
2547 if (right - rects[i].right < - inner_width)
2548 {
2549 if (i != first_group_count
2550 && right - rects[i].right >= - DIALOG_MAX_INNER_WIDTH)
2551 inner_width = - (right - rects[i].right);
2552 else
2553 {
2554 bottom -= max_height + DIALOG_BUTTON_BUTTON_VERTICAL_SPACE;
2555 right = max_height = 0;
2556 }
2557 }
2558 if (max_height < rects[i].bottom)
2559 max_height = rects[i].bottom;
2560 OffsetRect (&rects[i], right - rects[i].right,
2561 bottom - rects[i].bottom);
2562 right = rects[i].left - DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE;
2563 if (i == first_group_count - 1)
2564 right -= DIALOG_BUTTON_BUTTON_HORIZONTAL_SPACE;
2565 }
2566 buttons_height = - (bottom - max_height);
2567
2568 left_align_shift = - (inner_width + rects[nb_buttons - 1].left);
2569 for (i = nb_buttons - 1; i >= first_group_count; i--)
2570 {
2571 if (bottom != rects[i].bottom)
2572 {
2573 left_align_shift = - (inner_width + rects[i].left);
2574 bottom = rects[i].bottom;
2575 }
2576 OffsetRect (&rects[i], left_align_shift, 0);
2577 }
2578 }
2579
2580 /* Create a static text control and measure its bounds. */
2581 if (err == noErr)
2582 {
2583 CFStringRef message_string;
2584 Rect bounds;
2585
2586 message_string = cfstring_create_with_utf8_cstring (message);
2587 if (message_string == NULL)
2588 err = memFullErr;
2589 else
2590 {
2591 ControlFontStyleRec text_style;
2592
2593 text_style.flags = 0;
2594 SetRect (&bounds, 0, 0, inner_width, 0);
2595 err = CreateStaticTextControl (window, &bounds, message_string,
2596 &text_style, &text);
2597 CFRelease (message_string);
2598 }
2599 if (err == noErr)
2600 {
2601 SInt16 unused;
2602
2603 bounds = empty_rect;
2604 err = GetBestControlRect (text, &bounds, &unused);
2605 }
2606 if (err == noErr)
2607 {
2608 text_height = bounds.bottom - bounds.top;
2609 if (text_height < DIALOG_TEXT_MIN_HEIGHT)
2610 text_height = DIALOG_TEXT_MIN_HEIGHT;
2611 }
2612 }
2613
2614 /* Place buttons. */
2615 if (err == noErr)
2616 {
2617 inner_height = (text_height + DIALOG_TEXT_BUTTONS_VERTICAL_SPACE
2618 + buttons_height);
2619
2620 for (i = 0; i < nb_buttons; i++)
2621 {
2622 OffsetRect (&rects[i], DIALOG_LEFT_MARGIN + inner_width,
2623 DIALOG_TOP_MARGIN + inner_height);
2624 SetControlBounds (buttons[i], &rects[i]);
2625 }
2626 }
2627
2628 /* Place text. */
2629 if (err == noErr)
2630 {
2631 Rect bounds;
2632
2633 SetRect (&bounds, DIALOG_LEFT_MARGIN, DIALOG_TOP_MARGIN,
2634 DIALOG_LEFT_MARGIN + inner_width,
2635 DIALOG_TOP_MARGIN + text_height);
2636 SetControlBounds (text, &bounds);
2637 }
2638
2639 /* Create the application icon at the upper-left corner. */
2640 if (err == noErr)
2641 {
2642 ControlButtonContentInfo content;
2643 ControlRef icon;
2644 static const ProcessSerialNumber psn = {0, kCurrentProcess};
2645 #ifdef MAC_OSX
2646 FSRef app_location;
2647 #else
2648 ProcessInfoRec pinfo;
2649 FSSpec app_spec;
2650 #endif
2651 SInt16 unused;
2652
2653 content.contentType = kControlContentIconRef;
2654 #ifdef MAC_OSX
2655 err = GetProcessBundleLocation (&psn, &app_location);
2656 if (err == noErr)
2657 err = GetIconRefFromFileInfo (&app_location, 0, NULL, 0, NULL,
2658 kIconServicesNormalUsageFlag,
2659 &content.u.iconRef, &unused);
2660 #else
2661 bzero (&pinfo, sizeof (ProcessInfoRec));
2662 pinfo.processInfoLength = sizeof (ProcessInfoRec);
2663 pinfo.processAppSpec = &app_spec;
2664 err = GetProcessInformation (&psn, &pinfo);
2665 if (err == noErr)
2666 err = GetIconRefFromFile (&app_spec, &content.u.iconRef, &unused);
2667 #endif
2668 if (err == noErr)
2669 {
2670 Rect bounds;
2671
2672 SetRect (&bounds, DIALOG_ICON_LEFT_MARGIN, DIALOG_ICON_TOP_MARGIN,
2673 DIALOG_ICON_LEFT_MARGIN + DIALOG_ICON_WIDTH,
2674 DIALOG_ICON_TOP_MARGIN + DIALOG_ICON_HEIGHT);
2675 err = CreateIconControl (window, &bounds, &content, true, &icon);
2676 ReleaseIconRef (content.u.iconRef);
2677 }
2678 }
2679
2680 /* Show the dialog window and run event loop. */
2681 if (err == noErr)
2682 if (default_button)
2683 err = SetWindowDefaultButton (window, default_button);
2684 if (err == noErr)
2685 err = install_dialog_event_handler (window);
2686 if (err == noErr)
2687 {
2688 SizeWindow (window,
2689 DIALOG_LEFT_MARGIN + inner_width + DIALOG_RIGHT_MARGIN,
2690 DIALOG_TOP_MARGIN + inner_height + DIALOG_BOTTOM_MARGIN,
2691 true);
2692 err = RepositionWindow (window, FRAME_MAC_WINDOW (f),
2693 kWindowAlertPositionOnParentWindow);
2694 }
2695 if (err == noErr)
2696 {
2697 SetWRefCon (window, 0);
2698 ShowWindow (window);
2699 BringToFront (window);
2700 err = RunAppModalLoopForWindow (window);
2701 }
2702 if (err == noErr)
2703 {
2704 UInt32 command_id = GetWRefCon (window);
2705
2706 if (DIALOG_BUTTON_COMMAND_ID_P (command_id))
2707 result = DIALOG_BUTTON_COMMAND_ID_VALUE (command_id);
2708 }
2709
2710 if (window)
2711 DisposeWindow (window);
2712
2713 return result;
2714 }
2715 #else /* not TARGET_API_MAC_CARBON */
2716 static int
2717 mac_dialog (widget_value *wv)
2718 {
2719 char *dialog_name;
2720 char *prompt;
2721 char **button_labels;
2722 UInt32 *ref_cons;
2723 int nb_buttons;
2724 int left_count;
2725 int i;
2726 int dialog_width;
2727 Rect rect;
2728 WindowRef window_ptr;
2729 ControlRef ch;
2730 int left;
2731 EventRecord event_record;
2732 SInt16 part_code;
2733 int control_part_code;
2734 Point mouse;
2735
2736 dialog_name = wv->name;
2737 nb_buttons = dialog_name[1] - '0';
2738 left_count = nb_buttons - (dialog_name[4] - '0');
2739 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
2740 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
2741
2742 wv = wv->contents;
2743 prompt = (char *) alloca (strlen (wv->value) + 1);
2744 strcpy (prompt, wv->value);
2745 c2pstr (prompt);
2746
2747 wv = wv->next;
2748 for (i = 0; i < nb_buttons; i++)
2749 {
2750 button_labels[i] = wv->value;
2751 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
2752 strcpy (button_labels[i], wv->value);
2753 c2pstr (button_labels[i]);
2754 ref_cons[i] = (UInt32) wv->call_data;
2755 wv = wv->next;
2756 }
2757
2758 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowRef) -1);
2759
2760 SetPortWindowPort (window_ptr);
2761
2762 TextFont (0);
2763 /* Left and right margins in the dialog are 13 pixels each.*/
2764 dialog_width = 14;
2765 /* Calculate width of dialog box: 8 pixels on each side of the text
2766 label in each button, 12 pixels between buttons. */
2767 for (i = 0; i < nb_buttons; i++)
2768 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
2769
2770 if (left_count != 0 && nb_buttons - left_count != 0)
2771 dialog_width += 12;
2772
2773 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
2774
2775 SizeWindow (window_ptr, dialog_width, 78, 0);
2776 ShowWindow (window_ptr);
2777
2778 SetPortWindowPort (window_ptr);
2779
2780 TextFont (0);
2781
2782 MoveTo (13, 29);
2783 DrawString (prompt);
2784
2785 left = 13;
2786 for (i = 0; i < nb_buttons; i++)
2787 {
2788 int button_width = StringWidth (button_labels[i]) + 16;
2789 SetRect (&rect, left, 45, left + button_width, 65);
2790 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2791 kControlPushButtonProc, ref_cons[i]);
2792 left += button_width + 12;
2793 if (i == left_count - 1)
2794 left += 12;
2795 }
2796
2797 i = 0;
2798 while (!i)
2799 {
2800 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2801 if (event_record.what == mouseDown)
2802 {
2803 part_code = FindWindow (event_record.where, &window_ptr);
2804 if (part_code == inContent)
2805 {
2806 mouse = event_record.where;
2807 GlobalToLocal (&mouse);
2808 control_part_code = FindControl (mouse, window_ptr, &ch);
2809 if (control_part_code == kControlButtonPart)
2810 if (TrackControl (ch, mouse, NULL))
2811 i = GetControlReference (ch);
2812 }
2813 }
2814 }
2815
2816 DisposeWindow (window_ptr);
2817
2818 return i;
2819 }
2820 #endif /* not TARGET_API_MAC_CARBON */
2821
2822 static char * button_names [] = {
2823 "button1", "button2", "button3", "button4", "button5",
2824 "button6", "button7", "button8", "button9", "button10" };
2825
2826 static Lisp_Object
2827 mac_dialog_show (f, keymaps, title, header, error_name)
2828 FRAME_PTR f;
2829 int keymaps;
2830 Lisp_Object title, header;
2831 char **error_name;
2832 {
2833 int i, nb_buttons=0;
2834 char dialog_name[6];
2835 int menu_item_selection;
2836
2837 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2838
2839 /* Number of elements seen so far, before boundary. */
2840 int left_count = 0;
2841 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2842 int boundary_seen = 0;
2843
2844 *error_name = NULL;
2845
2846 if (menu_items_n_panes > 1)
2847 {
2848 *error_name = "Multiple panes in dialog box";
2849 return Qnil;
2850 }
2851
2852 /* Create a tree of widget_value objects
2853 representing the text label and buttons. */
2854 {
2855 Lisp_Object pane_name, prefix;
2856 char *pane_string;
2857 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2858 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2859 pane_string = (NILP (pane_name)
2860 ? "" : (char *) SDATA (pane_name));
2861 prev_wv = xmalloc_widget_value ();
2862 prev_wv->value = pane_string;
2863 if (keymaps && !NILP (prefix))
2864 prev_wv->name++;
2865 prev_wv->enabled = 1;
2866 prev_wv->name = "message";
2867 prev_wv->help = Qnil;
2868 first_wv = prev_wv;
2869
2870 /* Loop over all panes and items, filling in the tree. */
2871 i = MENU_ITEMS_PANE_LENGTH;
2872 while (i < menu_items_used)
2873 {
2874
2875 /* Create a new item within current pane. */
2876 Lisp_Object item_name, enable, descrip;
2877 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2878 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2879 descrip
2880 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2881
2882 if (NILP (item_name))
2883 {
2884 free_menubar_widget_value_tree (first_wv);
2885 *error_name = "Submenu in dialog items";
2886 return Qnil;
2887 }
2888 if (EQ (item_name, Qquote))
2889 {
2890 /* This is the boundary between left-side elts
2891 and right-side elts. Stop incrementing right_count. */
2892 boundary_seen = 1;
2893 i++;
2894 continue;
2895 }
2896 if (nb_buttons >= 9)
2897 {
2898 free_menubar_widget_value_tree (first_wv);
2899 *error_name = "Too many dialog items";
2900 return Qnil;
2901 }
2902
2903 wv = xmalloc_widget_value ();
2904 prev_wv->next = wv;
2905 wv->name = (char *) button_names[nb_buttons];
2906 if (!NILP (descrip))
2907 wv->key = (char *) SDATA (descrip);
2908 wv->value = (char *) SDATA (item_name);
2909 wv->call_data = (void *) i;
2910 /* menu item is identified by its index in menu_items table */
2911 wv->enabled = !NILP (enable);
2912 wv->help = Qnil;
2913 prev_wv = wv;
2914
2915 if (! boundary_seen)
2916 left_count++;
2917
2918 nb_buttons++;
2919 i += MENU_ITEMS_ITEM_LENGTH;
2920 }
2921
2922 /* If the boundary was not specified,
2923 by default put half on the left and half on the right. */
2924 if (! boundary_seen)
2925 left_count = nb_buttons - nb_buttons / 2;
2926
2927 wv = xmalloc_widget_value ();
2928 wv->name = dialog_name;
2929 wv->help = Qnil;
2930
2931 /* Frame title: 'Q' = Question, 'I' = Information.
2932 Can also have 'E' = Error if, one day, we want
2933 a popup for errors. */
2934 if (NILP(header))
2935 dialog_name[0] = 'Q';
2936 else
2937 dialog_name[0] = 'I';
2938
2939 /* Dialog boxes use a really stupid name encoding
2940 which specifies how many buttons to use
2941 and how many buttons are on the right. */
2942 dialog_name[1] = '0' + nb_buttons;
2943 dialog_name[2] = 'B';
2944 dialog_name[3] = 'R';
2945 /* Number of buttons to put on the right. */
2946 dialog_name[4] = '0' + nb_buttons - left_count;
2947 dialog_name[5] = 0;
2948 wv->contents = first_wv;
2949 first_wv = wv;
2950 }
2951
2952 /* Force a redisplay before showing the dialog. If a frame is created
2953 just before showing the dialog, its contents may not have been fully
2954 drawn. */
2955 Fredisplay (Qt);
2956
2957 /* Actually create the dialog. */
2958 #if TARGET_API_MAC_CARBON
2959 menu_item_selection = create_and_show_dialog (f, first_wv);
2960 #else
2961 menu_item_selection = mac_dialog (first_wv);
2962 #endif
2963
2964 /* Free the widget_value objects we used to specify the contents. */
2965 free_menubar_widget_value_tree (first_wv);
2966
2967 /* Find the selected item, and its pane, to return
2968 the proper value. */
2969 if (menu_item_selection != 0)
2970 {
2971 Lisp_Object prefix;
2972
2973 prefix = Qnil;
2974 i = 0;
2975 while (i < menu_items_used)
2976 {
2977 Lisp_Object entry;
2978
2979 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2980 {
2981 prefix
2982 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2983 i += MENU_ITEMS_PANE_LENGTH;
2984 }
2985 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2986 {
2987 /* This is the boundary between left-side elts and
2988 right-side elts. */
2989 ++i;
2990 }
2991 else
2992 {
2993 entry
2994 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2995 if (menu_item_selection == i)
2996 {
2997 if (keymaps != 0)
2998 {
2999 entry = Fcons (entry, Qnil);
3000 if (!NILP (prefix))
3001 entry = Fcons (prefix, entry);
3002 }
3003 return entry;
3004 }
3005 i += MENU_ITEMS_ITEM_LENGTH;
3006 }
3007 }
3008 }
3009 else
3010 /* Make "Cancel" equivalent to C-g. */
3011 Fsignal (Qquit, Qnil);
3012
3013 return Qnil;
3014 }
3015 #endif /* HAVE_DIALOGS */
3016 \f
3017
3018 /* Is this item a separator? */
3019 static int
3020 name_is_separator (name)
3021 const char *name;
3022 {
3023 const char *start = name;
3024
3025 /* Check if name string consists of only dashes ('-'). */
3026 while (*name == '-') name++;
3027 /* Separators can also be of the form "--:TripleSuperMegaEtched"
3028 or "--deep-shadow". We don't implement them yet, se we just treat
3029 them like normal separators. */
3030 return (*name == '\0' || start + 2 == name);
3031 }
3032
3033 static void
3034 add_menu_item (menu, pos, wv)
3035 MenuRef menu;
3036 int pos;
3037 widget_value *wv;
3038 {
3039 #if TARGET_API_MAC_CARBON
3040 CFStringRef item_name;
3041 #else
3042 Str255 item_name;
3043 #endif
3044
3045 if (name_is_separator (wv->name))
3046 AppendMenu (menu, "\p-");
3047 else
3048 {
3049 AppendMenu (menu, "\pX");
3050
3051 #if TARGET_API_MAC_CARBON
3052 item_name = cfstring_create_with_utf8_cstring (wv->name);
3053
3054 if (wv->key != NULL)
3055 {
3056 CFStringRef name, key;
3057
3058 name = item_name;
3059 key = cfstring_create_with_utf8_cstring (wv->key);
3060 item_name = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@ %@"),
3061 name, key);
3062 CFRelease (name);
3063 CFRelease (key);
3064 }
3065
3066 SetMenuItemTextWithCFString (menu, pos, item_name);
3067 CFRelease (item_name);
3068
3069 if (wv->enabled)
3070 EnableMenuItem (menu, pos);
3071 else
3072 DisableMenuItem (menu, pos);
3073
3074 if (STRINGP (wv->help))
3075 SetMenuItemProperty (menu, pos, MAC_EMACS_CREATOR_CODE, 'help',
3076 sizeof (Lisp_Object), &wv->help);
3077 #else /* ! TARGET_API_MAC_CARBON */
3078 item_name[sizeof (item_name) - 1] = '\0';
3079 strncpy (item_name, wv->name, sizeof (item_name) - 1);
3080 if (wv->key != NULL)
3081 {
3082 int len = strlen (item_name);
3083
3084 strncpy (item_name + len, " ", sizeof (item_name) - 1 - len);
3085 len = strlen (item_name);
3086 strncpy (item_name + len, wv->key, sizeof (item_name) - 1 - len);
3087 }
3088 c2pstr (item_name);
3089 SetMenuItemText (menu, pos, item_name);
3090
3091 if (wv->enabled)
3092 EnableItem (menu, pos);
3093 else
3094 DisableItem (menu, pos);
3095 #endif /* ! TARGET_API_MAC_CARBON */
3096
3097 /* Draw radio buttons and tickboxes. */
3098 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
3099 wv->button_type == BUTTON_TYPE_RADIO))
3100 SetItemMark (menu, pos, checkMark);
3101 else
3102 SetItemMark (menu, pos, noMark);
3103
3104 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
3105 }
3106 }
3107
3108 /* Construct native Mac OS menu based on widget_value tree. */
3109
3110 static int
3111 fill_menu (menu, wv, kind, submenu_id)
3112 MenuRef menu;
3113 widget_value *wv;
3114 enum mac_menu_kind kind;
3115 int submenu_id;
3116 {
3117 int pos;
3118
3119 for (pos = 1; wv != NULL; wv = wv->next, pos++)
3120 {
3121 add_menu_item (menu, pos, wv);
3122 if (wv->contents && submenu_id < min_menu_id[kind + 1])
3123 {
3124 MenuRef submenu = NewMenu (submenu_id, "\pX");
3125
3126 InsertMenu (submenu, -1);
3127 SetMenuItemHierarchicalID (menu, pos, submenu_id);
3128 submenu_id = fill_menu (submenu, wv->contents, kind, submenu_id + 1);
3129 }
3130 }
3131
3132 return submenu_id;
3133 }
3134
3135 /* Construct native Mac OS menubar based on widget_value tree. */
3136
3137 static void
3138 fill_menubar (wv, deep_p)
3139 widget_value *wv;
3140 int deep_p;
3141 {
3142 int id, submenu_id;
3143 #if !TARGET_API_MAC_CARBON
3144 int title_changed_p = 0;
3145 #endif
3146
3147 /* Clean up the menu bar when filled by the entire menu trees. */
3148 if (deep_p)
3149 {
3150 dispose_menus (MAC_MENU_MENU_BAR, 0);
3151 dispose_menus (MAC_MENU_MENU_BAR_SUB, 0);
3152 #if !TARGET_API_MAC_CARBON
3153 title_changed_p = 1;
3154 #endif
3155 }
3156
3157 /* Fill menu bar titles and submenus. Reuse the existing menu bar
3158 titles as much as possible to minimize redraw (if !deep_p). */
3159 submenu_id = min_menu_id[MAC_MENU_MENU_BAR_SUB];
3160 for (id = min_menu_id[MAC_MENU_MENU_BAR];
3161 wv != NULL && id < min_menu_id[MAC_MENU_MENU_BAR + 1];
3162 wv = wv->next, id++)
3163 {
3164 OSStatus err = noErr;
3165 MenuRef menu;
3166 #if TARGET_API_MAC_CARBON
3167 CFStringRef title;
3168
3169 title = CFStringCreateWithCString (NULL, wv->name,
3170 kCFStringEncodingMacRoman);
3171 #else
3172 Str255 title;
3173
3174 strncpy (title, wv->name, 255);
3175 title[255] = '\0';
3176 c2pstr (title);
3177 #endif
3178
3179 menu = GetMenuRef (id);
3180 if (menu)
3181 {
3182 #if TARGET_API_MAC_CARBON
3183 CFStringRef old_title;
3184
3185 err = CopyMenuTitleAsCFString (menu, &old_title);
3186 if (err == noErr)
3187 {
3188 if (CFStringCompare (title, old_title, 0) != kCFCompareEqualTo)
3189 err = SetMenuTitleWithCFString (menu, title);
3190 CFRelease (old_title);
3191 }
3192 else
3193 err = SetMenuTitleWithCFString (menu, title);
3194 #else /* !TARGET_API_MAC_CARBON */
3195 if (!EqualString (title, (*menu)->menuData, false, false))
3196 {
3197 DeleteMenu (id);
3198 DisposeMenu (menu);
3199 menu = NewMenu (id, title);
3200 InsertMenu (menu, GetMenuRef (id + 1) ? id + 1 : 0);
3201 title_changed_p = 1;
3202 }
3203 #endif /* !TARGET_API_MAC_CARBON */
3204 }
3205 else
3206 {
3207 #if TARGET_API_MAC_CARBON
3208 err = CreateNewMenu (id, 0, &menu);
3209 if (err == noErr)
3210 err = SetMenuTitleWithCFString (menu, title);
3211 #else
3212 menu = NewMenu (id, title);
3213 #endif
3214 if (err == noErr)
3215 {
3216 InsertMenu (menu, 0);
3217 #if !TARGET_API_MAC_CARBON
3218 title_changed_p = 1;
3219 #endif
3220 }
3221 }
3222 #if TARGET_API_MAC_CARBON
3223 CFRelease (title);
3224 #endif
3225
3226 if (err == noErr)
3227 if (wv->contents)
3228 submenu_id = fill_menu (menu, wv->contents, MAC_MENU_MENU_BAR_SUB,
3229 submenu_id);
3230 }
3231
3232 if (id < min_menu_id[MAC_MENU_MENU_BAR + 1] && GetMenuRef (id))
3233 {
3234 dispose_menus (MAC_MENU_MENU_BAR, id);
3235 #if !TARGET_API_MAC_CARBON
3236 title_changed_p = 1;
3237 #endif
3238 }
3239
3240 #if !TARGET_API_MAC_CARBON
3241 if (title_changed_p)
3242 InvalMenuBar ();
3243 #endif
3244 }
3245
3246 /* Dispose of menus that belong to KIND, and remove them from the menu
3247 list. ID is the lower bound of menu IDs that will be processed. */
3248
3249 static void
3250 dispose_menus (kind, id)
3251 enum mac_menu_kind kind;
3252 int id;
3253 {
3254 for (id = max (id, min_menu_id[kind]); id < min_menu_id[kind + 1]; id++)
3255 {
3256 MenuRef menu = GetMenuRef (id);
3257
3258 if (menu == NULL)
3259 break;
3260 DeleteMenu (id);
3261 DisposeMenu (menu);
3262 }
3263 }
3264
3265 #endif /* HAVE_MENUS */
3266
3267 /* Detect if a menu is currently active. */
3268
3269 int
3270 popup_activated ()
3271 {
3272 return popup_activated_flag;
3273 }
3274
3275 /* The following is used by delayed window autoselection. */
3276
3277 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
3278 doc: /* Return t if a menu or popup dialog is active. */)
3279 ()
3280 {
3281 /* Always return Qnil since menu selection functions do not return
3282 until a selection has been made or cancelled. */
3283 return Qnil;
3284 }
3285 \f
3286 void
3287 syms_of_macmenu ()
3288 {
3289 staticpro (&menu_items);
3290 menu_items = Qnil;
3291
3292 Qdebug_on_next_call = intern ("debug-on-next-call");
3293 staticpro (&Qdebug_on_next_call);
3294
3295 defsubr (&Sx_popup_menu);
3296 defsubr (&Smenu_or_popup_active_p);
3297 #ifdef HAVE_MENUS
3298 defsubr (&Sx_popup_dialog);
3299 #endif
3300 }
3301
3302 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
3303 (do not change this comment) */