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