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