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