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