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