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