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