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