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