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