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