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