]> code.delx.au - gnu-emacs/blob - src/macmenu.c
[TARGET_API_MAC_CARBON]: Don't include headers that are included via
[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., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Contributed by Andrew Choi (akochoi@mac.com). */
22
23 #include <config.h>
24 #include <signal.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 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
607 doc: /* Pop up a deck-of-cards menu and return user's selection.
608 POSITION is a position specification. This is either a mouse button
609 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
610 are positions in pixels from the top left corner of WINDOW's frame
611 \(WINDOW may be a frame object instead of a window). This controls the
612 position of the center of the first line in the first pane of the
613 menu, not the top left of the menu as a whole. If POSITION is t, it
614 means to use the current mouse position.
615
616 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
617 The menu items come from key bindings that have a menu string as well as
618 a definition; actually, the \"definition\" in such a key binding looks like
619 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
620 the keymap as a top-level element.
621
622 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
623 Otherwise, REAL-DEFINITION should be a valid key binding definition.
624
625 You can also use a list of keymaps as MENU. Then each keymap makes a
626 separate pane. When MENU is a keymap or a list of keymaps, the return
627 value is a list of events.
628
629 Alternatively, you can specify a menu of multiple panes with a list of
630 the form (TITLE PANE1 PANE2...), where each pane is a list of
631 form (TITLE ITEM1 ITEM2...).
632 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
633 appear as an item--that makes a nonselectable line in the menu.
634 With this form of menu, the return value is VALUE from the chosen item.
635
636 If POSITION is nil, don't display the menu at all, just precalculate the
637 cached information about equivalent key sequences. */)
638 (position, menu)
639 Lisp_Object position, menu;
640 {
641 Lisp_Object keymap, tem;
642 int xpos = 0, ypos = 0;
643 Lisp_Object title;
644 char *error_name;
645 Lisp_Object selection;
646 FRAME_PTR f = NULL;
647 Lisp_Object x, y, window;
648 int keymaps = 0;
649 int for_click = 0;
650 struct gcpro gcpro1;
651
652 #ifdef HAVE_MENUS
653 if (! NILP (position))
654 {
655 check_mac ();
656
657 /* Decode the first argument: find the window and the coordinates. */
658 if (EQ (position, Qt)
659 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
660 || EQ (XCAR (position), Qtool_bar))))
661 {
662 /* Use the mouse's current position. */
663 FRAME_PTR new_f = SELECTED_FRAME ();
664 Lisp_Object bar_window;
665 enum scroll_bar_part part;
666 unsigned long time;
667
668 if (mouse_position_hook)
669 (*mouse_position_hook) (&new_f, 1, &bar_window,
670 &part, &x, &y, &time);
671 if (new_f != 0)
672 XSETFRAME (window, new_f);
673 else
674 {
675 window = selected_window;
676 XSETFASTINT (x, 0);
677 XSETFASTINT (y, 0);
678 }
679 }
680 else
681 {
682 tem = Fcar (position);
683 if (CONSP (tem))
684 {
685 window = Fcar (Fcdr (position));
686 x = Fcar (tem);
687 y = Fcar (Fcdr (tem));
688 }
689 else
690 {
691 for_click = 1;
692 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
693 window = Fcar (tem); /* POSN_WINDOW (tem) */
694 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
695 x = Fcar (tem);
696 y = Fcdr (tem);
697 }
698 }
699
700 CHECK_NUMBER (x);
701 CHECK_NUMBER (y);
702
703 /* Decode where to put the menu. */
704
705 if (FRAMEP (window))
706 {
707 f = XFRAME (window);
708 xpos = 0;
709 ypos = 0;
710 }
711 else if (WINDOWP (window))
712 {
713 CHECK_LIVE_WINDOW (window);
714 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
715
716 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
717 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
718 }
719 else
720 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
721 but I don't want to make one now. */
722 CHECK_WINDOW (window);
723
724 xpos += XINT (x);
725 ypos += XINT (y);
726
727 XSETFRAME (Vmenu_updating_frame, f);
728 }
729 Vmenu_updating_frame = Qnil;
730 #endif /* HAVE_MENUS */
731
732 title = Qnil;
733 GCPRO1 (title);
734
735 /* Decode the menu items from what was specified. */
736
737 keymap = get_keymap (menu, 0, 0);
738 if (CONSP (keymap))
739 {
740 /* We were given a keymap. Extract menu info from the keymap. */
741 Lisp_Object prompt;
742
743 /* Extract the detailed info to make one pane. */
744 keymap_panes (&menu, 1, NILP (position));
745
746 /* Search for a string appearing directly as an element of the keymap.
747 That string is the title of the menu. */
748 prompt = Fkeymap_prompt (keymap);
749 if (NILP (title) && !NILP (prompt))
750 title = prompt;
751
752 /* Make that be the pane title of the first pane. */
753 if (!NILP (prompt) && menu_items_n_panes >= 0)
754 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
755
756 keymaps = 1;
757 }
758 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
759 {
760 /* We were given a list of keymaps. */
761 int nmaps = XFASTINT (Flength (menu));
762 Lisp_Object *maps
763 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
764 int i;
765
766 title = Qnil;
767
768 /* The first keymap that has a prompt string
769 supplies the menu title. */
770 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
771 {
772 Lisp_Object prompt;
773
774 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
775
776 prompt = Fkeymap_prompt (keymap);
777 if (NILP (title) && !NILP (prompt))
778 title = prompt;
779 }
780
781 /* Extract the detailed info to make one pane. */
782 keymap_panes (maps, nmaps, NILP (position));
783
784 /* Make the title be the pane title of the first pane. */
785 if (!NILP (title) && menu_items_n_panes >= 0)
786 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
787
788 keymaps = 1;
789 }
790 else
791 {
792 /* We were given an old-fashioned menu. */
793 title = Fcar (menu);
794 CHECK_STRING (title);
795
796 list_of_panes (Fcdr (menu));
797
798 keymaps = 0;
799 }
800
801 if (NILP (position))
802 {
803 discard_menu_items ();
804 UNGCPRO;
805 return Qnil;
806 }
807
808 #ifdef HAVE_MENUS
809 /* Display them in a menu. */
810 BLOCK_INPUT;
811
812 selection = mac_menu_show (f, xpos, ypos, for_click,
813 keymaps, title, &error_name);
814 UNBLOCK_INPUT;
815
816 discard_menu_items ();
817
818 UNGCPRO;
819 #endif /* HAVE_MENUS */
820
821 if (error_name) error (error_name);
822 return selection;
823 }
824
825 #ifdef HAVE_MENUS
826
827 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
828 doc: /* Pop up a dialog box and return user's selection.
829 POSITION specifies which frame to use.
830 This is normally a mouse button event or a window or frame.
831 If POSITION is t, it means to use the frame the mouse is on.
832 The dialog box appears in the middle of the specified frame.
833
834 CONTENTS specifies the alternatives to display in the dialog box.
835 It is a list of the form (TITLE ITEM1 ITEM2...).
836 Each ITEM is a cons cell (STRING . VALUE).
837 The return value is VALUE from the chosen item.
838
839 An ITEM may also be just a string--that makes a nonselectable item.
840 An ITEM may also be nil--that means to put all preceding items
841 on the left of the dialog box and all following items on the right.
842 \(By default, approximately half appear on each side.) */)
843 (position, contents)
844 Lisp_Object position, contents;
845 {
846 FRAME_PTR f = NULL;
847 Lisp_Object window;
848
849 check_mac ();
850
851 /* Decode the first argument: find the window or frame to use. */
852 if (EQ (position, Qt)
853 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
854 || EQ (XCAR (position), Qtool_bar))))
855 {
856 #if 0 /* Using the frame the mouse is on may not be right. */
857 /* Use the mouse's current position. */
858 FRAME_PTR new_f = SELECTED_FRAME ();
859 Lisp_Object bar_window;
860 enum scroll_bar_part part;
861 unsigned long time;
862 Lisp_Object x, y;
863
864 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
865
866 if (new_f != 0)
867 XSETFRAME (window, new_f);
868 else
869 window = selected_window;
870 #endif
871 window = selected_window;
872 }
873 else if (CONSP (position))
874 {
875 Lisp_Object tem;
876 tem = Fcar (position);
877 if (CONSP (tem))
878 window = Fcar (Fcdr (position));
879 else
880 {
881 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
882 window = Fcar (tem); /* POSN_WINDOW (tem) */
883 }
884 }
885 else if (WINDOWP (position) || FRAMEP (position))
886 window = position;
887 else
888 window = Qnil;
889
890 /* Decode where to put the menu. */
891
892 if (FRAMEP (window))
893 f = XFRAME (window);
894 else if (WINDOWP (window))
895 {
896 CHECK_LIVE_WINDOW (window);
897 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
898 }
899 else
900 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
901 but I don't want to make one now. */
902 CHECK_WINDOW (window);
903
904 #ifndef HAVE_DIALOGS
905 /* Display a menu with these alternatives
906 in the middle of frame F. */
907 {
908 Lisp_Object x, y, frame, newpos;
909 XSETFRAME (frame, f);
910 XSETINT (x, x_pixel_width (f) / 2);
911 XSETINT (y, x_pixel_height (f) / 2);
912 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
913
914 return Fx_popup_menu (newpos,
915 Fcons (Fcar (contents), Fcons (contents, Qnil)));
916 }
917 #else /* HAVE_DIALOGS */
918 {
919 Lisp_Object title;
920 char *error_name;
921 Lisp_Object selection;
922
923 /* Decode the dialog items from what was specified. */
924 title = Fcar (contents);
925 CHECK_STRING (title);
926
927 list_of_panes (Fcons (contents, Qnil));
928
929 /* Display them in a dialog box. */
930 BLOCK_INPUT;
931 selection = mac_dialog_show (f, 0, title, &error_name);
932 UNBLOCK_INPUT;
933
934 discard_menu_items ();
935
936 if (error_name) error (error_name);
937 return selection;
938 }
939 #endif /* HAVE_DIALOGS */
940 }
941
942 /* Activate the menu bar of frame F.
943 This is called from keyboard.c when it gets the
944 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
945
946 To activate the menu bar, we signal to the input thread that it can
947 return from the WM_INITMENU message, allowing the normal Windows
948 processing of the menus.
949
950 But first we recompute the menu bar contents (the whole tree).
951
952 This way we can safely execute Lisp code. */
953
954 void
955 x_activate_menubar (f)
956 FRAME_PTR f;
957 {
958 SInt32 menu_choice;
959 extern Point saved_menu_event_location;
960
961 set_frame_menubar (f, 0, 1);
962 BLOCK_INPUT;
963
964 menu_choice = MenuSelect (saved_menu_event_location);
965 do_menu_choice (menu_choice);
966
967 UNBLOCK_INPUT;
968 }
969
970 /* This callback is called from the menu bar pulldown menu
971 when the user makes a selection.
972 Figure out what the user chose
973 and put the appropriate events into the keyboard buffer. */
974
975 void
976 menubar_selection_callback (FRAME_PTR f, int client_data)
977 {
978 Lisp_Object prefix, entry;
979 Lisp_Object vector;
980 Lisp_Object *subprefix_stack;
981 int submenu_depth = 0;
982 int i;
983
984 if (!f)
985 return;
986 entry = Qnil;
987 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
988 vector = f->menu_bar_vector;
989 prefix = Qnil;
990 i = 0;
991 while (i < f->menu_bar_items_used)
992 {
993 if (EQ (XVECTOR (vector)->contents[i], Qnil))
994 {
995 subprefix_stack[submenu_depth++] = prefix;
996 prefix = entry;
997 i++;
998 }
999 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1000 {
1001 prefix = subprefix_stack[--submenu_depth];
1002 i++;
1003 }
1004 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1005 {
1006 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1007 i += MENU_ITEMS_PANE_LENGTH;
1008 }
1009 else
1010 {
1011 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1012 /* The EMACS_INT cast avoids a warning. There's no problem
1013 as long as pointers have enough bits to hold small integers. */
1014 if ((int) (EMACS_INT) client_data == i)
1015 {
1016 int j;
1017 struct input_event buf;
1018 Lisp_Object frame;
1019 EVENT_INIT (buf);
1020
1021 XSETFRAME (frame, f);
1022 buf.kind = MENU_BAR_EVENT;
1023 buf.frame_or_window = frame;
1024 buf.arg = frame;
1025 kbd_buffer_store_event (&buf);
1026
1027 for (j = 0; j < submenu_depth; j++)
1028 if (!NILP (subprefix_stack[j]))
1029 {
1030 buf.kind = MENU_BAR_EVENT;
1031 buf.frame_or_window = frame;
1032 buf.arg = subprefix_stack[j];
1033 kbd_buffer_store_event (&buf);
1034 }
1035
1036 if (!NILP (prefix))
1037 {
1038 buf.kind = MENU_BAR_EVENT;
1039 buf.frame_or_window = frame;
1040 buf.arg = prefix;
1041 kbd_buffer_store_event (&buf);
1042 }
1043
1044 buf.kind = MENU_BAR_EVENT;
1045 buf.frame_or_window = frame;
1046 buf.arg = entry;
1047 kbd_buffer_store_event (&buf);
1048
1049 f->output_data.mac->menu_command_in_progress = 0;
1050 f->output_data.mac->menubar_active = 0;
1051 return;
1052 }
1053 i += MENU_ITEMS_ITEM_LENGTH;
1054 }
1055 }
1056 f->output_data.mac->menu_command_in_progress = 0;
1057 f->output_data.mac->menubar_active = 0;
1058 }
1059
1060 /* Allocate a widget_value, blocking input. */
1061
1062 widget_value *
1063 xmalloc_widget_value ()
1064 {
1065 widget_value *value;
1066
1067 BLOCK_INPUT;
1068 value = malloc_widget_value ();
1069 UNBLOCK_INPUT;
1070
1071 return value;
1072 }
1073
1074 /* This recursively calls free_widget_value on the tree of widgets.
1075 It must free all data that was malloc'ed for these widget_values.
1076 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1077 must be left alone. */
1078
1079 void
1080 free_menubar_widget_value_tree (wv)
1081 widget_value *wv;
1082 {
1083 if (! wv) return;
1084
1085 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1086
1087 if (wv->contents && (wv->contents != (widget_value*)1))
1088 {
1089 free_menubar_widget_value_tree (wv->contents);
1090 wv->contents = (widget_value *) 0xDEADBEEF;
1091 }
1092 if (wv->next)
1093 {
1094 free_menubar_widget_value_tree (wv->next);
1095 wv->next = (widget_value *) 0xDEADBEEF;
1096 }
1097 BLOCK_INPUT;
1098 free_widget_value (wv);
1099 UNBLOCK_INPUT;
1100 }
1101 \f
1102 /* Return a tree of widget_value structures for a menu bar item
1103 whose event type is ITEM_KEY (with string ITEM_NAME)
1104 and whose contents come from the list of keymaps MAPS. */
1105
1106 static widget_value *
1107 single_submenu (item_key, item_name, maps)
1108 Lisp_Object item_key, item_name, maps;
1109 {
1110 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1111 int i;
1112 int submenu_depth = 0;
1113 Lisp_Object length;
1114 int len;
1115 Lisp_Object *mapvec;
1116 widget_value **submenu_stack;
1117 int previous_items = menu_items_used;
1118 int top_level_items = 0;
1119
1120 length = Flength (maps);
1121 len = XINT (length);
1122
1123 /* Convert the list MAPS into a vector MAPVEC. */
1124 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1125 for (i = 0; i < len; i++)
1126 {
1127 mapvec[i] = Fcar (maps);
1128 maps = Fcdr (maps);
1129 }
1130
1131 menu_items_n_panes = 0;
1132
1133 /* Loop over the given keymaps, making a pane for each map.
1134 But don't make a pane that is empty--ignore that map instead. */
1135 for (i = 0; i < len; i++)
1136 {
1137 if (SYMBOLP (mapvec[i])
1138 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1139 {
1140 /* Here we have a command at top level in the menu bar
1141 as opposed to a submenu. */
1142 top_level_items = 1;
1143 push_menu_pane (Qnil, Qnil);
1144 push_menu_item (item_name, Qt, item_key, mapvec[i],
1145 Qnil, Qnil, Qnil, Qnil);
1146 }
1147 else
1148 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1149 }
1150
1151 /* Create a tree of widget_value objects
1152 representing the panes and their items. */
1153
1154 submenu_stack
1155 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1156 wv = xmalloc_widget_value ();
1157 wv->name = "menu";
1158 wv->value = 0;
1159 wv->enabled = 1;
1160 wv->button_type = BUTTON_TYPE_NONE;
1161 wv->help = Qnil;
1162 first_wv = wv;
1163 save_wv = 0;
1164 prev_wv = 0;
1165
1166 /* Loop over all panes and items made during this call
1167 and construct a tree of widget_value objects.
1168 Ignore the panes and items made by previous calls to
1169 single_submenu, even though those are also in menu_items. */
1170 i = previous_items;
1171 while (i < menu_items_used)
1172 {
1173 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1174 {
1175 submenu_stack[submenu_depth++] = save_wv;
1176 save_wv = prev_wv;
1177 prev_wv = 0;
1178 i++;
1179 }
1180 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1181 {
1182 prev_wv = save_wv;
1183 save_wv = submenu_stack[--submenu_depth];
1184 i++;
1185 }
1186 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1187 && submenu_depth != 0)
1188 i += MENU_ITEMS_PANE_LENGTH;
1189 /* Ignore a nil in the item list.
1190 It's meaningful only for dialog boxes. */
1191 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1192 i += 1;
1193 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1194 {
1195 /* Create a new pane. */
1196 Lisp_Object pane_name, prefix;
1197 char *pane_string;
1198
1199 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1200 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1201
1202 #ifndef HAVE_MULTILINGUAL_MENU
1203 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1204 {
1205 pane_name = ENCODE_SYSTEM (pane_name);
1206 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1207 }
1208 #endif
1209 pane_string = (NILP (pane_name)
1210 ? "" : (char *) SDATA (pane_name));
1211 /* If there is just one top-level pane, put all its items directly
1212 under the top-level menu. */
1213 if (menu_items_n_panes == 1)
1214 pane_string = "";
1215
1216 /* If the pane has a meaningful name,
1217 make the pane a top-level menu item
1218 with its items as a submenu beneath it. */
1219 if (strcmp (pane_string, ""))
1220 {
1221 wv = xmalloc_widget_value ();
1222 if (save_wv)
1223 save_wv->next = wv;
1224 else
1225 first_wv->contents = wv;
1226 wv->lname = pane_name;
1227 /* Set value to 1 so update_submenu_strings can handle '@' */
1228 wv->value = (char *)1;
1229 wv->enabled = 1;
1230 wv->button_type = BUTTON_TYPE_NONE;
1231 wv->help = Qnil;
1232 }
1233 save_wv = wv;
1234 prev_wv = 0;
1235 i += MENU_ITEMS_PANE_LENGTH;
1236 }
1237 else
1238 {
1239 /* Create a new item within current pane. */
1240 Lisp_Object item_name, enable, descrip, def, type, selected;
1241 Lisp_Object help;
1242
1243 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1244 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1245 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1246 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1247 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1248 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1249 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1250
1251 #ifndef HAVE_MULTILINGUAL_MENU
1252 if (STRING_MULTIBYTE (item_name))
1253 {
1254 item_name = ENCODE_MENU_STRING (item_name);
1255 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1256 }
1257
1258 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1259 {
1260 descrip = ENCODE_MENU_STRING (descrip);
1261 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1262 }
1263 #endif /* not HAVE_MULTILINGUAL_MENU */
1264
1265 wv = xmalloc_widget_value ();
1266 if (prev_wv)
1267 prev_wv->next = wv;
1268 else
1269 save_wv->contents = wv;
1270
1271 wv->lname = item_name;
1272 if (!NILP (descrip))
1273 wv->lkey = descrip;
1274 wv->value = 0;
1275 /* The EMACS_INT cast avoids a warning. There's no problem
1276 as long as pointers have enough bits to hold small integers. */
1277 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1278 wv->enabled = !NILP (enable);
1279
1280 if (NILP (type))
1281 wv->button_type = BUTTON_TYPE_NONE;
1282 else if (EQ (type, QCradio))
1283 wv->button_type = BUTTON_TYPE_RADIO;
1284 else if (EQ (type, QCtoggle))
1285 wv->button_type = BUTTON_TYPE_TOGGLE;
1286 else
1287 abort ();
1288
1289 wv->selected = !NILP (selected);
1290 if (!STRINGP (help))
1291 help = Qnil;
1292
1293 wv->help = help;
1294
1295 prev_wv = wv;
1296
1297 i += MENU_ITEMS_ITEM_LENGTH;
1298 }
1299 }
1300
1301 /* If we have just one "menu item"
1302 that was originally a button, return it by itself. */
1303 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1304 {
1305 wv = first_wv->contents;
1306 free_widget_value (first_wv);
1307 return wv;
1308 }
1309
1310 return first_wv;
1311 }
1312 /* Walk through the widget_value tree starting at FIRST_WV and update
1313 the char * pointers from the corresponding lisp values.
1314 We do this after building the whole tree, since GC may happen while the
1315 tree is constructed, and small strings are relocated. So we must wait
1316 until no GC can happen before storing pointers into lisp values. */
1317 static void
1318 update_submenu_strings (first_wv)
1319 widget_value *first_wv;
1320 {
1321 widget_value *wv;
1322
1323 for (wv = first_wv; wv; wv = wv->next)
1324 {
1325 if (STRINGP (wv->lname))
1326 {
1327 wv->name = SDATA (wv->lname);
1328
1329 /* Ignore the @ that means "separate pane".
1330 This is a kludge, but this isn't worth more time. */
1331 if (wv->value == (char *)1)
1332 {
1333 if (wv->name[0] == '@')
1334 wv->name++;
1335 wv->value = 0;
1336 }
1337 }
1338
1339 if (STRINGP (wv->lkey))
1340 wv->key = SDATA (wv->lkey);
1341
1342 if (wv->contents)
1343 update_submenu_strings (wv->contents);
1344 }
1345 }
1346
1347 \f
1348 /* Set the contents of the menubar widgets of frame F.
1349 The argument FIRST_TIME is currently ignored;
1350 it is set the first time this is called, from initialize_frame_menubar. */
1351
1352 void
1353 set_frame_menubar (f, first_time, deep_p)
1354 FRAME_PTR f;
1355 int first_time;
1356 int deep_p;
1357 {
1358 int menubar_widget = f->output_data.mac->menubar_widget;
1359 Lisp_Object items;
1360 widget_value *wv, *first_wv, *prev_wv = 0;
1361 int i;
1362
1363 /* We must not change the menubar when actually in use. */
1364 if (f->output_data.mac->menubar_active)
1365 return;
1366
1367 XSETFRAME (Vmenu_updating_frame, f);
1368
1369 if (! menubar_widget)
1370 deep_p = 1;
1371 else if (pending_menu_activation && !deep_p)
1372 deep_p = 1;
1373
1374 wv = xmalloc_widget_value ();
1375 wv->name = "menubar";
1376 wv->value = 0;
1377 wv->enabled = 1;
1378 wv->button_type = BUTTON_TYPE_NONE;
1379 wv->help = Qnil;
1380 first_wv = wv;
1381
1382 if (deep_p)
1383 {
1384 /* Make a widget-value tree representing the entire menu trees. */
1385
1386 struct buffer *prev = current_buffer;
1387 Lisp_Object buffer;
1388 int specpdl_count = SPECPDL_INDEX ();
1389 int previous_menu_items_used = f->menu_bar_items_used;
1390 Lisp_Object *previous_items
1391 = (Lisp_Object *) alloca (previous_menu_items_used
1392 * sizeof (Lisp_Object));
1393
1394 /* If we are making a new widget, its contents are empty,
1395 do always reinitialize them. */
1396 if (! menubar_widget)
1397 previous_menu_items_used = 0;
1398
1399 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1400 specbind (Qinhibit_quit, Qt);
1401 /* Don't let the debugger step into this code
1402 because it is not reentrant. */
1403 specbind (Qdebug_on_next_call, Qnil);
1404
1405 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1406 if (NILP (Voverriding_local_map_menu_flag))
1407 {
1408 specbind (Qoverriding_terminal_local_map, Qnil);
1409 specbind (Qoverriding_local_map, Qnil);
1410 }
1411
1412 set_buffer_internal_1 (XBUFFER (buffer));
1413
1414 /* Run the Lucid hook. */
1415 safe_run_hooks (Qactivate_menubar_hook);
1416 /* If it has changed current-menubar from previous value,
1417 really recompute the menubar from the value. */
1418 if (! NILP (Vlucid_menu_bar_dirty_flag))
1419 call0 (Qrecompute_lucid_menubar);
1420 safe_run_hooks (Qmenu_bar_update_hook);
1421 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1422
1423 items = FRAME_MENU_BAR_ITEMS (f);
1424
1425 /* Save the frame's previous menu bar contents data. */
1426 if (previous_menu_items_used)
1427 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1428 previous_menu_items_used * sizeof (Lisp_Object));
1429
1430 /* Fill in the current menu bar contents. */
1431 menu_items = f->menu_bar_vector;
1432 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1433 init_menu_items ();
1434 for (i = 0; i < XVECTOR (items)->size; i += 4)
1435 {
1436 Lisp_Object key, string, maps;
1437
1438 key = XVECTOR (items)->contents[i];
1439 string = XVECTOR (items)->contents[i + 1];
1440 maps = XVECTOR (items)->contents[i + 2];
1441 if (NILP (string))
1442 break;
1443
1444 wv = single_submenu (key, string, maps);
1445 if (prev_wv)
1446 prev_wv->next = wv;
1447 else
1448 first_wv->contents = wv;
1449 /* Don't set wv->name here; GC during the loop might relocate it. */
1450 wv->enabled = 1;
1451 wv->button_type = BUTTON_TYPE_NONE;
1452 prev_wv = wv;
1453 }
1454
1455 finish_menu_items ();
1456
1457 set_buffer_internal_1 (prev);
1458 unbind_to (specpdl_count, Qnil);
1459
1460 /* If there has been no change in the Lisp-level contents
1461 of the menu bar, skip redisplaying it. Just exit. */
1462
1463 for (i = 0; i < previous_menu_items_used; i++)
1464 if (menu_items_used == i
1465 || (NILP (Fequal (previous_items[i],
1466 XVECTOR (menu_items)->contents[i]))))
1467 break;
1468 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1469 {
1470 free_menubar_widget_value_tree (first_wv);
1471 menu_items = Qnil;
1472
1473 return;
1474 }
1475
1476 /* Now GC cannot happen during the lifetime of the widget_value,
1477 so it's safe to store data from a Lisp_String, as long as
1478 local copies are made when the actual menu is created.
1479 Windows takes care of this for normal string items, but
1480 not for owner-drawn items or additional item-info. */
1481 wv = first_wv->contents;
1482 for (i = 0; i < XVECTOR (items)->size; i += 4)
1483 {
1484 Lisp_Object string;
1485 string = XVECTOR (items)->contents[i + 1];
1486 if (NILP (string))
1487 break;
1488 wv->name = (char *) SDATA (string);
1489 update_submenu_strings (wv->contents);
1490 wv = wv->next;
1491 }
1492
1493 f->menu_bar_vector = menu_items;
1494 f->menu_bar_items_used = menu_items_used;
1495 menu_items = Qnil;
1496 }
1497 else
1498 {
1499 /* Make a widget-value tree containing
1500 just the top level menu bar strings. */
1501
1502 items = FRAME_MENU_BAR_ITEMS (f);
1503 for (i = 0; i < XVECTOR (items)->size; i += 4)
1504 {
1505 Lisp_Object string;
1506
1507 string = XVECTOR (items)->contents[i + 1];
1508 if (NILP (string))
1509 break;
1510
1511 wv = xmalloc_widget_value ();
1512 wv->name = (char *) SDATA (string);
1513 wv->value = 0;
1514 wv->enabled = 1;
1515 wv->button_type = BUTTON_TYPE_NONE;
1516 wv->help = Qnil;
1517 /* This prevents lwlib from assuming this
1518 menu item is really supposed to be empty. */
1519 /* The EMACS_INT cast avoids a warning.
1520 This value just has to be different from small integers. */
1521 wv->call_data = (void *) (EMACS_INT) (-1);
1522
1523 if (prev_wv)
1524 prev_wv->next = wv;
1525 else
1526 first_wv->contents = wv;
1527 prev_wv = wv;
1528 }
1529
1530 /* Forget what we thought we knew about what is in the
1531 detailed contents of the menu bar menus.
1532 Changing the top level always destroys the contents. */
1533 f->menu_bar_items_used = 0;
1534 }
1535
1536 /* Create or update the menu bar widget. */
1537
1538 BLOCK_INPUT;
1539
1540 /* Non-null value to indicate menubar has already been "created". */
1541 f->output_data.mac->menubar_widget = 1;
1542
1543 {
1544 int i = MIN_MENU_ID;
1545 MenuHandle menu = GetMenuHandle (i);
1546 while (menu != NULL)
1547 {
1548 DeleteMenu (i);
1549 DisposeMenu (menu);
1550 menu = GetMenuHandle (++i);
1551 }
1552
1553 i = MIN_SUBMENU_ID;
1554 menu = GetMenuHandle (i);
1555 while (menu != NULL)
1556 {
1557 DeleteMenu (i);
1558 DisposeMenu (menu);
1559 menu = GetMenuHandle (++i);
1560 }
1561 }
1562
1563 fill_menubar (first_wv->contents);
1564
1565 DrawMenuBar ();
1566
1567 free_menubar_widget_value_tree (first_wv);
1568
1569 UNBLOCK_INPUT;
1570 }
1571
1572 /* Called from Fx_create_frame to create the initial menubar of a frame
1573 before it is mapped, so that the window is mapped with the menubar already
1574 there instead of us tacking it on later and thrashing the window after it
1575 is visible. */
1576
1577 void
1578 initialize_frame_menubar (f)
1579 FRAME_PTR f;
1580 {
1581 /* This function is called before the first chance to redisplay
1582 the frame. It has to be, so the frame will have the right size. */
1583 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1584 set_frame_menubar (f, 1, 1);
1585 }
1586
1587 /* Get rid of the menu bar of frame F, and free its storage.
1588 This is used when deleting a frame, and when turning off the menu bar. */
1589
1590 void
1591 free_frame_menubar (f)
1592 FRAME_PTR f;
1593 {
1594 f->output_data.mac->menubar_widget = NULL;
1595 }
1596
1597 \f
1598 /* mac_menu_show actually displays a menu using the panes and items in
1599 menu_items and returns the value selected from it; we assume input
1600 is blocked by the caller. */
1601
1602 /* F is the frame the menu is for.
1603 X and Y are the frame-relative specified position,
1604 relative to the inside upper left corner of the frame F.
1605 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1606 KEYMAPS is 1 if this menu was specified with keymaps;
1607 in that case, we return a list containing the chosen item's value
1608 and perhaps also the pane's prefix.
1609 TITLE is the specified menu title.
1610 ERROR is a place to store an error message string in case of failure.
1611 (We return nil on failure, but the value doesn't actually matter.) */
1612
1613 static Lisp_Object
1614 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1615 FRAME_PTR f;
1616 int x;
1617 int y;
1618 int for_click;
1619 int keymaps;
1620 Lisp_Object title;
1621 char **error;
1622 {
1623 int i;
1624 UInt32 refcon;
1625 int menu_item_choice;
1626 int menu_item_selection;
1627 MenuHandle menu;
1628 Point pos;
1629 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1630 widget_value **submenu_stack
1631 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1632 Lisp_Object *subprefix_stack
1633 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1634 int submenu_depth = 0;
1635 int first_pane;
1636
1637 *error = NULL;
1638
1639 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1640 {
1641 *error = "Empty menu";
1642 return Qnil;
1643 }
1644
1645 /* Create a tree of widget_value objects
1646 representing the panes and their items. */
1647 wv = xmalloc_widget_value ();
1648 wv->name = "menu";
1649 wv->value = 0;
1650 wv->enabled = 1;
1651 wv->button_type = BUTTON_TYPE_NONE;
1652 wv->help = Qnil;
1653 first_wv = wv;
1654 first_pane = 1;
1655
1656 /* Loop over all panes and items, filling in the tree. */
1657 i = 0;
1658 while (i < menu_items_used)
1659 {
1660 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1661 {
1662 submenu_stack[submenu_depth++] = save_wv;
1663 save_wv = prev_wv;
1664 prev_wv = 0;
1665 first_pane = 1;
1666 i++;
1667 }
1668 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1669 {
1670 prev_wv = save_wv;
1671 save_wv = submenu_stack[--submenu_depth];
1672 first_pane = 0;
1673 i++;
1674 }
1675 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1676 && submenu_depth != 0)
1677 i += MENU_ITEMS_PANE_LENGTH;
1678 /* Ignore a nil in the item list.
1679 It's meaningful only for dialog boxes. */
1680 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1681 i += 1;
1682 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1683 {
1684 /* Create a new pane. */
1685 Lisp_Object pane_name, prefix;
1686 char *pane_string;
1687 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1688 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1689 #ifndef HAVE_MULTILINGUAL_MENU
1690 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1691 {
1692 pane_name = ENCODE_SYSTEM (pane_name);
1693 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1694 }
1695 #endif
1696 pane_string = (NILP (pane_name)
1697 ? "" : (char *) SDATA (pane_name));
1698 /* If there is just one top-level pane, put all its items directly
1699 under the top-level menu. */
1700 if (menu_items_n_panes == 1)
1701 pane_string = "";
1702
1703 /* If the pane has a meaningful name,
1704 make the pane a top-level menu item
1705 with its items as a submenu beneath it. */
1706 if (!keymaps && strcmp (pane_string, ""))
1707 {
1708 wv = xmalloc_widget_value ();
1709 if (save_wv)
1710 save_wv->next = wv;
1711 else
1712 first_wv->contents = wv;
1713 wv->name = pane_string;
1714 if (keymaps && !NILP (prefix))
1715 wv->name++;
1716 wv->value = 0;
1717 wv->enabled = 1;
1718 wv->button_type = BUTTON_TYPE_NONE;
1719 wv->help = Qnil;
1720 save_wv = wv;
1721 prev_wv = 0;
1722 }
1723 else if (first_pane)
1724 {
1725 save_wv = wv;
1726 prev_wv = 0;
1727 }
1728 first_pane = 0;
1729 i += MENU_ITEMS_PANE_LENGTH;
1730 }
1731 else
1732 {
1733 /* Create a new item within current pane. */
1734 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1735
1736 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1737 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1738 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1739 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1740 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1741 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1742 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1743
1744 #ifndef HAVE_MULTILINGUAL_MENU
1745 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1746 {
1747 item_name = ENCODE_MENU_STRING (item_name);
1748 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1749 }
1750 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1751 {
1752 descrip = ENCODE_MENU_STRING (descrip);
1753 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1754 }
1755 #endif /* not HAVE_MULTILINGUAL_MENU */
1756
1757 wv = xmalloc_widget_value ();
1758 if (prev_wv)
1759 prev_wv->next = wv;
1760 else
1761 save_wv->contents = wv;
1762 wv->name = (char *) SDATA (item_name);
1763 if (!NILP (descrip))
1764 wv->key = (char *) SDATA (descrip);
1765 wv->value = 0;
1766 /* Use the contents index as call_data, since we are
1767 restricted to 16-bits. */
1768 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1769 wv->enabled = !NILP (enable);
1770
1771 if (NILP (type))
1772 wv->button_type = BUTTON_TYPE_NONE;
1773 else if (EQ (type, QCtoggle))
1774 wv->button_type = BUTTON_TYPE_TOGGLE;
1775 else if (EQ (type, QCradio))
1776 wv->button_type = BUTTON_TYPE_RADIO;
1777 else
1778 abort ();
1779
1780 wv->selected = !NILP (selected);
1781 if (!STRINGP (help))
1782 help = Qnil;
1783
1784 wv->help = help;
1785
1786 prev_wv = wv;
1787
1788 i += MENU_ITEMS_ITEM_LENGTH;
1789 }
1790 }
1791
1792 /* Deal with the title, if it is non-nil. */
1793 if (!NILP (title))
1794 {
1795 widget_value *wv_title = xmalloc_widget_value ();
1796 widget_value *wv_sep = xmalloc_widget_value ();
1797
1798 /* Maybe replace this separator with a bitmap or owner-draw item
1799 so that it looks better. Having two separators looks odd. */
1800 wv_sep->name = "--";
1801 wv_sep->next = first_wv->contents;
1802 wv_sep->help = Qnil;
1803
1804 #ifndef HAVE_MULTILINGUAL_MENU
1805 if (STRING_MULTIBYTE (title))
1806 title = ENCODE_MENU_STRING (title);
1807 #endif
1808 wv_title->name = (char *) SDATA (title);
1809 wv_title->enabled = TRUE;
1810 wv_title->title = TRUE;
1811 wv_title->button_type = BUTTON_TYPE_NONE;
1812 wv_title->help = Qnil;
1813 wv_title->next = wv_sep;
1814 first_wv->contents = wv_title;
1815 }
1816
1817 /* Actually create the menu. */
1818 menu = NewMenu (POPUP_SUBMENU_ID, "\p");
1819 submenu_id = MIN_POPUP_SUBMENU_ID;
1820 fill_submenu (menu, first_wv->contents);
1821
1822 /* Adjust coordinates to be root-window-relative. */
1823 pos.h = x;
1824 pos.v = y;
1825
1826 SetPortWindowPort (FRAME_MAC_WINDOW (f));
1827
1828 LocalToGlobal (&pos);
1829
1830 /* No selection has been chosen yet. */
1831 menu_item_choice = 0;
1832 menu_item_selection = 0;
1833
1834 InsertMenu (menu, -1);
1835
1836 /* Display the menu. */
1837 menu_item_choice = PopUpMenuSelect (menu, pos.v, pos.h, 0);
1838 menu_item_selection = LoWord (menu_item_choice);
1839
1840 /* Get the refcon to find the correct item*/
1841 if (menu_item_selection)
1842 {
1843 MenuHandle sel_menu = GetMenuHandle (HiWord (menu_item_choice));
1844 if (sel_menu) {
1845 GetMenuItemRefCon (sel_menu, menu_item_selection, &refcon);
1846 }
1847 }
1848
1849 #if 0
1850 /* Clean up extraneous mouse events which might have been generated
1851 during the call. */
1852 discard_mouse_events ();
1853 #endif
1854
1855 /* Must reset this manually because the button release event is not
1856 passed to Emacs event loop. */
1857 FRAME_MAC_DISPLAY_INFO (f)->grabbed = 0;
1858
1859 /* Free the widget_value objects we used to specify the
1860 contents. */
1861 free_menubar_widget_value_tree (first_wv);
1862
1863 /* delete all menus */
1864 {
1865 int i = MIN_POPUP_SUBMENU_ID;
1866 MenuHandle submenu = GetMenuHandle (i);
1867 while (submenu != NULL)
1868 {
1869 DeleteMenu (i);
1870 DisposeMenu (submenu);
1871 submenu = GetMenuHandle (++i);
1872 }
1873 }
1874
1875 DeleteMenu (POPUP_SUBMENU_ID);
1876 DisposeMenu (menu);
1877
1878 /* Find the selected item, and its pane, to return
1879 the proper value. */
1880 if (menu_item_selection != 0)
1881 {
1882 Lisp_Object prefix, entry;
1883
1884 prefix = entry = Qnil;
1885 i = 0;
1886 while (i < menu_items_used)
1887 {
1888 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1889 {
1890 subprefix_stack[submenu_depth++] = prefix;
1891 prefix = entry;
1892 i++;
1893 }
1894 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1895 {
1896 prefix = subprefix_stack[--submenu_depth];
1897 i++;
1898 }
1899 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1900 {
1901 prefix
1902 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1903 i += MENU_ITEMS_PANE_LENGTH;
1904 }
1905 /* Ignore a nil in the item list.
1906 It's meaningful only for dialog boxes. */
1907 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1908 i += 1;
1909 else
1910 {
1911 entry
1912 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1913 if ((int) (EMACS_INT) refcon == i)
1914 {
1915 if (keymaps != 0)
1916 {
1917 int j;
1918
1919 entry = Fcons (entry, Qnil);
1920 if (!NILP (prefix))
1921 entry = Fcons (prefix, entry);
1922 for (j = submenu_depth - 1; j >= 0; j--)
1923 if (!NILP (subprefix_stack[j]))
1924 entry = Fcons (subprefix_stack[j], entry);
1925 }
1926 return entry;
1927 }
1928 i += MENU_ITEMS_ITEM_LENGTH;
1929 }
1930 }
1931 }
1932
1933 return Qnil;
1934 }
1935 \f
1936
1937 #ifdef HAVE_DIALOGS
1938 /* Construct native Mac OS menubar based on widget_value tree. */
1939
1940 static int
1941 mac_dialog (widget_value *wv)
1942 {
1943 char *dialog_name;
1944 char *prompt;
1945 char **button_labels;
1946 UInt32 *ref_cons;
1947 int nb_buttons;
1948 int left_count;
1949 int i;
1950 int dialog_width;
1951 Rect rect;
1952 WindowPtr window_ptr;
1953 ControlHandle ch;
1954 int left;
1955 EventRecord event_record;
1956 SInt16 part_code;
1957 int control_part_code;
1958 Point mouse;
1959
1960 dialog_name = wv->name;
1961 nb_buttons = dialog_name[1] - '0';
1962 left_count = nb_buttons - (dialog_name[4] - '0');
1963 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
1964 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
1965
1966 wv = wv->contents;
1967 prompt = (char *) alloca (strlen (wv->value) + 1);
1968 strcpy (prompt, wv->value);
1969 c2pstr (prompt);
1970
1971 wv = wv->next;
1972 for (i = 0; i < nb_buttons; i++)
1973 {
1974 button_labels[i] = wv->value;
1975 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
1976 strcpy (button_labels[i], wv->value);
1977 c2pstr (button_labels[i]);
1978 ref_cons[i] = (UInt32) wv->call_data;
1979 wv = wv->next;
1980 }
1981
1982 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
1983
1984 SetPortWindowPort (window_ptr);
1985
1986 TextFont (0);
1987 /* Left and right margins in the dialog are 13 pixels each.*/
1988 dialog_width = 14;
1989 /* Calculate width of dialog box: 8 pixels on each side of the text
1990 label in each button, 12 pixels between buttons. */
1991 for (i = 0; i < nb_buttons; i++)
1992 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
1993
1994 if (left_count != 0 && nb_buttons - left_count != 0)
1995 dialog_width += 12;
1996
1997 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
1998
1999 SizeWindow (window_ptr, dialog_width, 78, 0);
2000 ShowWindow (window_ptr);
2001
2002 SetPortWindowPort (window_ptr);
2003
2004 TextFont (0);
2005
2006 MoveTo (13, 29);
2007 DrawString (prompt);
2008
2009 left = 13;
2010 for (i = 0; i < nb_buttons; i++)
2011 {
2012 int button_width = StringWidth (button_labels[i]) + 16;
2013 SetRect (&rect, left, 45, left + button_width, 65);
2014 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2015 kControlPushButtonProc, ref_cons[i]);
2016 left += button_width + 12;
2017 if (i == left_count - 1)
2018 left += 12;
2019 }
2020
2021 i = 0;
2022 while (!i)
2023 {
2024 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2025 if (event_record.what == mouseDown)
2026 {
2027 part_code = FindWindow (event_record.where, &window_ptr);
2028 if (part_code == inContent)
2029 {
2030 mouse = event_record.where;
2031 GlobalToLocal (&mouse);
2032 control_part_code = FindControl (mouse, window_ptr, &ch);
2033 if (control_part_code == kControlButtonPart)
2034 if (TrackControl (ch, mouse, NULL))
2035 i = GetControlReference (ch);
2036 }
2037 }
2038 }
2039
2040 DisposeWindow (window_ptr);
2041
2042 return i;
2043 }
2044
2045 static char * button_names [] = {
2046 "button1", "button2", "button3", "button4", "button5",
2047 "button6", "button7", "button8", "button9", "button10" };
2048
2049 static Lisp_Object
2050 mac_dialog_show (f, keymaps, title, error)
2051 FRAME_PTR f;
2052 int keymaps;
2053 Lisp_Object title;
2054 char **error;
2055 {
2056 int i, nb_buttons=0;
2057 char dialog_name[6];
2058 int menu_item_selection;
2059
2060 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2061
2062 /* Number of elements seen so far, before boundary. */
2063 int left_count = 0;
2064 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2065 int boundary_seen = 0;
2066
2067 *error = NULL;
2068
2069 if (menu_items_n_panes > 1)
2070 {
2071 *error = "Multiple panes in dialog box";
2072 return Qnil;
2073 }
2074
2075 /* Create a tree of widget_value objects
2076 representing the text label and buttons. */
2077 {
2078 Lisp_Object pane_name, prefix;
2079 char *pane_string;
2080 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2081 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2082 pane_string = (NILP (pane_name)
2083 ? "" : (char *) SDATA (pane_name));
2084 prev_wv = xmalloc_widget_value ();
2085 prev_wv->value = pane_string;
2086 if (keymaps && !NILP (prefix))
2087 prev_wv->name++;
2088 prev_wv->enabled = 1;
2089 prev_wv->name = "message";
2090 prev_wv->help = Qnil;
2091 first_wv = prev_wv;
2092
2093 /* Loop over all panes and items, filling in the tree. */
2094 i = MENU_ITEMS_PANE_LENGTH;
2095 while (i < menu_items_used)
2096 {
2097
2098 /* Create a new item within current pane. */
2099 Lisp_Object item_name, enable, descrip, help;
2100
2101 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2102 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2103 descrip
2104 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2105 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
2106
2107 if (NILP (item_name))
2108 {
2109 free_menubar_widget_value_tree (first_wv);
2110 *error = "Submenu in dialog items";
2111 return Qnil;
2112 }
2113 if (EQ (item_name, Qquote))
2114 {
2115 /* This is the boundary between left-side elts
2116 and right-side elts. Stop incrementing right_count. */
2117 boundary_seen = 1;
2118 i++;
2119 continue;
2120 }
2121 if (nb_buttons >= 9)
2122 {
2123 free_menubar_widget_value_tree (first_wv);
2124 *error = "Too many dialog items";
2125 return Qnil;
2126 }
2127
2128 wv = xmalloc_widget_value ();
2129 prev_wv->next = wv;
2130 wv->name = (char *) button_names[nb_buttons];
2131 if (!NILP (descrip))
2132 wv->key = (char *) SDATA (descrip);
2133 wv->value = (char *) SDATA (item_name);
2134 wv->call_data = (void *) i;
2135 /* menu item is identified by its index in menu_items table */
2136 wv->enabled = !NILP (enable);
2137 wv->help = Qnil;
2138 prev_wv = wv;
2139
2140 if (! boundary_seen)
2141 left_count++;
2142
2143 nb_buttons++;
2144 i += MENU_ITEMS_ITEM_LENGTH;
2145 }
2146
2147 /* If the boundary was not specified,
2148 by default put half on the left and half on the right. */
2149 if (! boundary_seen)
2150 left_count = nb_buttons - nb_buttons / 2;
2151
2152 wv = xmalloc_widget_value ();
2153 wv->name = dialog_name;
2154 wv->help = Qnil;
2155
2156 /* Dialog boxes use a really stupid name encoding
2157 which specifies how many buttons to use
2158 and how many buttons are on the right.
2159 The Q means something also. */
2160 dialog_name[0] = 'Q';
2161 dialog_name[1] = '0' + nb_buttons;
2162 dialog_name[2] = 'B';
2163 dialog_name[3] = 'R';
2164 /* Number of buttons to put on the right. */
2165 dialog_name[4] = '0' + nb_buttons - left_count;
2166 dialog_name[5] = 0;
2167 wv->contents = first_wv;
2168 first_wv = wv;
2169 }
2170
2171 /* Actually create the dialog. */
2172 #ifdef HAVE_DIALOGS
2173 menu_item_selection = mac_dialog (first_wv);
2174 #else
2175 menu_item_selection = 0;
2176 #endif
2177
2178 /* Free the widget_value objects we used to specify the contents. */
2179 free_menubar_widget_value_tree (first_wv);
2180
2181 /* Find the selected item, and its pane, to return the proper
2182 value. */
2183 if (menu_item_selection != 0)
2184 {
2185 Lisp_Object prefix;
2186
2187 prefix = Qnil;
2188 i = 0;
2189 while (i < menu_items_used)
2190 {
2191 Lisp_Object entry;
2192
2193 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2194 {
2195 prefix
2196 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2197 i += MENU_ITEMS_PANE_LENGTH;
2198 }
2199 else
2200 {
2201 entry
2202 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2203 if (menu_item_selection == i)
2204 {
2205 if (keymaps != 0)
2206 {
2207 entry = Fcons (entry, Qnil);
2208 if (!NILP (prefix))
2209 entry = Fcons (prefix, entry);
2210 }
2211 return entry;
2212 }
2213 i += MENU_ITEMS_ITEM_LENGTH;
2214 }
2215 }
2216 }
2217
2218 return Qnil;
2219 }
2220 #endif /* HAVE_DIALOGS */
2221 \f
2222
2223 /* Is this item a separator? */
2224 static int
2225 name_is_separator (name)
2226 char *name;
2227 {
2228 char *start = name;
2229
2230 /* Check if name string consists of only dashes ('-'). */
2231 while (*name == '-') name++;
2232 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2233 or "--deep-shadow". We don't implement them yet, se we just treat
2234 them like normal separators. */
2235 return (*name == '\0' || start + 2 == name);
2236 }
2237
2238 static void
2239 add_menu_item (MenuHandle menu, widget_value *wv, int submenu,
2240 int force_disable)
2241 {
2242 Str255 item_name;
2243 int pos;
2244
2245 if (name_is_separator (wv->name))
2246 AppendMenu (menu, "\p-");
2247 else
2248 {
2249 AppendMenu (menu, "\pX");
2250
2251 #if TARGET_API_MAC_CARBON
2252 pos = CountMenuItems (menu);
2253 #else
2254 pos = CountMItems (menu);
2255 #endif
2256
2257 strcpy (item_name, "");
2258 strncat (item_name, wv->name, 255);
2259 if (wv->key != NULL)
2260 {
2261 strncat (item_name, " ", 255);
2262 strncat (item_name, wv->key, 255);
2263 }
2264 item_name[255] = 0;
2265 #if TARGET_API_MAC_CARBON
2266 {
2267 CFStringRef string = cfstring_create_with_utf8_cstring (item_name);
2268
2269 SetMenuItemTextWithCFString (menu, pos, string);
2270 CFRelease (string);
2271 }
2272 #else
2273 c2pstr (item_name);
2274 SetMenuItemText (menu, pos, item_name);
2275 #endif
2276
2277 if (wv->enabled && !force_disable)
2278 #if TARGET_API_MAC_CARBON
2279 EnableMenuItem (menu, pos);
2280 #else
2281 EnableItem (menu, pos);
2282 #endif
2283 else
2284 #if TARGET_API_MAC_CARBON
2285 DisableMenuItem (menu, pos);
2286 #else
2287 DisableItem (menu, pos);
2288 #endif
2289
2290 /* Draw radio buttons and tickboxes. */
2291 {
2292 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2293 wv->button_type == BUTTON_TYPE_RADIO))
2294 SetItemMark (menu, pos, checkMark);
2295 else
2296 SetItemMark (menu, pos, noMark);
2297 }
2298
2299 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
2300 }
2301
2302 if (submenu != NULL)
2303 SetMenuItemHierarchicalID (menu, pos, submenu);
2304 }
2305
2306 /* Construct native Mac OS menubar based on widget_value tree. */
2307
2308 static void
2309 fill_submenu (MenuHandle menu, widget_value *wv)
2310 {
2311 for ( ; wv != NULL; wv = wv->next)
2312 if (wv->contents)
2313 {
2314 int cur_submenu = submenu_id++;
2315 MenuHandle submenu = NewMenu (cur_submenu, "\pX");
2316 fill_submenu (submenu, wv->contents);
2317 InsertMenu (submenu, -1);
2318 add_menu_item (menu, wv, cur_submenu, 0);
2319 }
2320 else
2321 add_menu_item (menu, wv, NULL, 0);
2322 }
2323
2324
2325 /* Construct native Mac OS menu based on widget_value tree. */
2326
2327 static void
2328 fill_menu (MenuHandle menu, widget_value *wv)
2329 {
2330 for ( ; wv != NULL; wv = wv->next)
2331 if (wv->contents)
2332 {
2333 int cur_submenu = submenu_id++;
2334 MenuHandle submenu = NewMenu (cur_submenu, "\pX");
2335 fill_submenu (submenu, wv->contents);
2336 InsertMenu (submenu, -1);
2337 add_menu_item (menu, wv, cur_submenu, 0);
2338 }
2339 else
2340 add_menu_item (menu, wv, NULL, 0);
2341 }
2342
2343 /* Construct native Mac OS menubar based on widget_value tree. */
2344
2345 static void
2346 fill_menubar (widget_value *wv)
2347 {
2348 int id;
2349
2350 submenu_id = MIN_SUBMENU_ID;
2351
2352 for (id = MIN_MENU_ID; wv != NULL; wv = wv->next, id++)
2353 {
2354 MenuHandle menu;
2355 Str255 title;
2356
2357 strncpy (title, wv->name, 255);
2358 title[255] = 0;
2359 c2pstr (title);
2360 menu = NewMenu (id, title);
2361
2362 if (wv->contents)
2363 fill_menu (menu, wv->contents);
2364
2365 InsertMenu (menu, 0);
2366 }
2367 }
2368
2369 #endif /* HAVE_MENUS */
2370
2371 \f
2372 void
2373 syms_of_macmenu ()
2374 {
2375 staticpro (&menu_items);
2376 menu_items = Qnil;
2377
2378 Qdebug_on_next_call = intern ("debug-on-next-call");
2379 staticpro (&Qdebug_on_next_call);
2380
2381 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2382 doc: /* Frame for which we are updating a menu.
2383 The enable predicate for a menu command should check this variable. */);
2384 Vmenu_updating_frame = Qnil;
2385
2386 defsubr (&Sx_popup_menu);
2387 #ifdef HAVE_MENUS
2388 defsubr (&Sx_popup_dialog);
2389 #endif
2390 }
2391
2392 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2393 (do not change this comment) */