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