(parse_single_submenu): Use individual keymap's prompt
[bpt/emacs.git] / src / xmenu.c
1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 88, 93, 94, 96, 99, 2000, 2001
3 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 /* X pop-up deck-of-cards menu facility for GNU Emacs.
23 *
24 * Written by Jon Arnold and Roman Budzianowski
25 * Mods and rewrite by Robert Krawitz
26 *
27 */
28
29 /* Modified by Fred Pierresteguy on December 93
30 to make the popup menus and menubar use the Xt. */
31
32 /* Rewritten for clarity and GC protection by rms in Feb 94. */
33
34 #include <config.h>
35
36 /* On 4.3 this loses if it comes after xterm.h. */
37 #include <signal.h>
38
39 #include <stdio.h>
40
41 #include "lisp.h"
42 #include "termhooks.h"
43 #include "keyboard.h"
44 #include "keymap.h"
45 #include "frame.h"
46 #include "window.h"
47 #include "blockinput.h"
48 #include "buffer.h"
49 #include "charset.h"
50 #include "coding.h"
51
52 #ifdef MSDOS
53 #include "msdos.h"
54 #endif
55
56 #ifdef HAVE_X_WINDOWS
57 /* This may include sys/types.h, and that somehow loses
58 if this is not done before the other system files. */
59 #include "xterm.h"
60 #endif
61
62 /* Load sys/types.h if not already loaded.
63 In some systems loading it twice is suicidal. */
64 #ifndef makedev
65 #include <sys/types.h>
66 #endif
67
68 #include "dispextern.h"
69
70 #ifdef HAVE_X_WINDOWS
71 #undef HAVE_MULTILINGUAL_MENU
72 #ifdef USE_X_TOOLKIT
73 #include "widget.h"
74 #include <X11/Xlib.h>
75 #include <X11/IntrinsicP.h>
76 #include <X11/CoreP.h>
77 #include <X11/StringDefs.h>
78 #include <X11/Shell.h>
79 #ifdef USE_LUCID
80 #include <X11/Xaw/Paned.h>
81 #endif /* USE_LUCID */
82 #include "../lwlib/lwlib.h"
83 #else /* not USE_X_TOOLKIT */
84 #include "../oldXMenu/XMenu.h"
85 #endif /* not USE_X_TOOLKIT */
86 #endif /* HAVE_X_WINDOWS */
87
88 #ifndef TRUE
89 #define TRUE 1
90 #define FALSE 0
91 #endif /* no TRUE */
92
93 Lisp_Object Vmenu_updating_frame;
94
95 Lisp_Object Qdebug_on_next_call;
96
97 extern Lisp_Object Qmenu_bar;
98 extern Lisp_Object Qmouse_click, Qevent_kind;
99
100 extern Lisp_Object QCtoggle, QCradio;
101
102 extern Lisp_Object Voverriding_local_map;
103 extern Lisp_Object Voverriding_local_map_menu_flag;
104
105 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
106
107 extern Lisp_Object Qmenu_bar_update_hook;
108
109 #ifdef USE_X_TOOLKIT
110 extern void set_frame_menubar ();
111 extern void process_expose_from_menu ();
112 extern XtAppContext Xt_app_con;
113
114 static Lisp_Object xdialog_show ();
115 static void popup_get_selection ();
116
117 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
118
119 #define HAVE_BOXES 1
120 #endif
121
122 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
123 Lisp_Object, Lisp_Object, Lisp_Object,
124 Lisp_Object, Lisp_Object));
125 static int update_frame_menubar P_ ((struct frame *));
126 static Lisp_Object xmenu_show P_ ((struct frame *, int, int, int, int,
127 Lisp_Object, char **));
128 static void keymap_panes P_ ((Lisp_Object *, int, int));
129 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
130 int, int));
131 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object *,
132 int, int, int *));
133 static void list_of_panes P_ ((Lisp_Object));
134 static void list_of_items P_ ((Lisp_Object));
135
136 extern EMACS_TIME timer_check P_ ((int));
137 \f
138 /* This holds a Lisp vector that holds the results of decoding
139 the keymaps or alist-of-alists that specify a menu.
140
141 It describes the panes and items within the panes.
142
143 Each pane is described by 3 elements in the vector:
144 t, the pane name, the pane's prefix key.
145 Then follow the pane's items, with 5 elements per item:
146 the item string, the enable flag, the item's value,
147 the definition, and the equivalent keyboard key's description string.
148
149 In some cases, multiple levels of menus may be described.
150 A single vector slot containing nil indicates the start of a submenu.
151 A single vector slot containing lambda indicates the end of a submenu.
152 The submenu follows a menu item which is the way to reach the submenu.
153
154 A single vector slot containing quote indicates that the
155 following items should appear on the right of a dialog box.
156
157 Using a Lisp vector to hold this information while we decode it
158 takes care of protecting all the data from GC. */
159
160 #define MENU_ITEMS_PANE_NAME 1
161 #define MENU_ITEMS_PANE_PREFIX 2
162 #define MENU_ITEMS_PANE_LENGTH 3
163
164 enum menu_item_idx
165 {
166 MENU_ITEMS_ITEM_NAME = 0,
167 MENU_ITEMS_ITEM_ENABLE,
168 MENU_ITEMS_ITEM_VALUE,
169 MENU_ITEMS_ITEM_EQUIV_KEY,
170 MENU_ITEMS_ITEM_DEFINITION,
171 MENU_ITEMS_ITEM_TYPE,
172 MENU_ITEMS_ITEM_SELECTED,
173 MENU_ITEMS_ITEM_HELP,
174 MENU_ITEMS_ITEM_LENGTH
175 };
176
177 static Lisp_Object menu_items;
178
179 /* If non-nil, means that the global vars defined here are already in use.
180 Used to detect cases where we try to re-enter this non-reentrant code. */
181 static Lisp_Object menu_items_inuse;
182
183 /* Number of slots currently allocated in menu_items. */
184 static int menu_items_allocated;
185
186 /* This is the index in menu_items of the first empty slot. */
187 static int menu_items_used;
188
189 /* The number of panes currently recorded in menu_items,
190 excluding those within submenus. */
191 static int menu_items_n_panes;
192
193 /* Current depth within submenus. */
194 static int menu_items_submenu_depth;
195
196 /* Flag which when set indicates a dialog or menu has been posted by
197 Xt on behalf of one of the widget sets. */
198 int popup_activated_flag;
199
200 static int next_menubar_widget_id;
201
202 /* This is set nonzero after the user activates the menu bar, and set
203 to zero again after the menu bars are redisplayed by prepare_menu_bar.
204 While it is nonzero, all calls to set_frame_menubar go deep.
205
206 I don't understand why this is needed, but it does seem to be
207 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
208
209 int pending_menu_activation;
210 \f
211 #ifdef USE_X_TOOLKIT
212
213 /* Return the frame whose ->output_data.x->id equals ID, or 0 if none. */
214
215 static struct frame *
216 menubar_id_to_frame (id)
217 LWLIB_ID id;
218 {
219 Lisp_Object tail, frame;
220 FRAME_PTR f;
221
222 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
223 {
224 frame = XCAR (tail);
225 if (!GC_FRAMEP (frame))
226 continue;
227 f = XFRAME (frame);
228 if (!FRAME_WINDOW_P (f))
229 continue;
230 if (f->output_data.x->id == id)
231 return f;
232 }
233 return 0;
234 }
235
236 #endif
237 \f
238 /* Initialize the menu_items structure if we haven't already done so.
239 Also mark it as currently empty. */
240
241 static void
242 init_menu_items ()
243 {
244 if (NILP (menu_items))
245 {
246 menu_items_allocated = 60;
247 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
248 }
249
250 if (!NILP (menu_items_inuse))
251 error ("Trying to use a menu from within a menu-entry");
252 menu_items_inuse = Qt;
253 menu_items_used = 0;
254 menu_items_n_panes = 0;
255 menu_items_submenu_depth = 0;
256 }
257
258 /* Call at the end of generating the data in menu_items. */
259
260 static void
261 finish_menu_items ()
262 {
263 }
264
265 static Lisp_Object
266 unuse_menu_items (dummy)
267 int dummy;
268 {
269 return menu_items_inuse = Qnil;
270 }
271
272 /* Call when finished using the data for the current menu
273 in menu_items. */
274
275 static void
276 discard_menu_items ()
277 {
278 /* Free the structure if it is especially large.
279 Otherwise, hold on to it, to save time. */
280 if (menu_items_allocated > 200)
281 {
282 menu_items = Qnil;
283 menu_items_allocated = 0;
284 }
285 xassert (NILP (menu_items_inuse));
286 }
287
288 /* Make the menu_items vector twice as large. */
289
290 static void
291 grow_menu_items ()
292 {
293 Lisp_Object old;
294 int old_size = menu_items_allocated;
295 old = menu_items;
296
297 menu_items_allocated *= 2;
298 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
299 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
300 old_size * sizeof (Lisp_Object));
301 }
302
303 /* Begin a submenu. */
304
305 static void
306 push_submenu_start ()
307 {
308 if (menu_items_used + 1 > menu_items_allocated)
309 grow_menu_items ();
310
311 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
312 menu_items_submenu_depth++;
313 }
314
315 /* End a submenu. */
316
317 static void
318 push_submenu_end ()
319 {
320 if (menu_items_used + 1 > menu_items_allocated)
321 grow_menu_items ();
322
323 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
324 menu_items_submenu_depth--;
325 }
326
327 /* Indicate boundary between left and right. */
328
329 static void
330 push_left_right_boundary ()
331 {
332 if (menu_items_used + 1 > menu_items_allocated)
333 grow_menu_items ();
334
335 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
336 }
337
338 /* Start a new menu pane in menu_items.
339 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
340
341 static void
342 push_menu_pane (name, prefix_vec)
343 Lisp_Object name, prefix_vec;
344 {
345 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
346 grow_menu_items ();
347
348 if (menu_items_submenu_depth == 0)
349 menu_items_n_panes++;
350 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
351 XVECTOR (menu_items)->contents[menu_items_used++] = name;
352 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
353 }
354
355 /* Push one menu item into the current pane. NAME is the string to
356 display. ENABLE if non-nil means this item can be selected. KEY
357 is the key generated by choosing this item, or nil if this item
358 doesn't really have a definition. DEF is the definition of this
359 item. EQUIV is the textual description of the keyboard equivalent
360 for this item (or nil if none). TYPE is the type of this menu
361 item, one of nil, `toggle' or `radio'. */
362
363 static void
364 push_menu_item (name, enable, key, def, equiv, type, selected, help)
365 Lisp_Object name, enable, key, def, equiv, type, selected, help;
366 {
367 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
368 grow_menu_items ();
369
370 XVECTOR (menu_items)->contents[menu_items_used++] = name;
371 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
372 XVECTOR (menu_items)->contents[menu_items_used++] = key;
373 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
374 XVECTOR (menu_items)->contents[menu_items_used++] = def;
375 XVECTOR (menu_items)->contents[menu_items_used++] = type;
376 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
377 XVECTOR (menu_items)->contents[menu_items_used++] = help;
378 }
379 \f
380 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
381 and generate menu panes for them in menu_items.
382 If NOTREAL is nonzero,
383 don't bother really computing whether an item is enabled. */
384
385 static void
386 keymap_panes (keymaps, nmaps, notreal)
387 Lisp_Object *keymaps;
388 int nmaps;
389 int notreal;
390 {
391 int mapno;
392
393 init_menu_items ();
394
395 /* Loop over the given keymaps, making a pane for each map.
396 But don't make a pane that is empty--ignore that map instead.
397 P is the number of panes we have made so far. */
398 for (mapno = 0; mapno < nmaps; mapno++)
399 single_keymap_panes (keymaps[mapno],
400 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
401
402 finish_menu_items ();
403 }
404
405 /* This is a recursive subroutine of keymap_panes.
406 It handles one keymap, KEYMAP.
407 The other arguments are passed along
408 or point to local variables of the previous function.
409 If NOTREAL is nonzero, only check for equivalent key bindings, don't
410 evaluate expressions in menu items and don't make any menu.
411
412 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
413
414 static void
415 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
416 Lisp_Object keymap;
417 Lisp_Object pane_name;
418 Lisp_Object prefix;
419 int notreal;
420 int maxdepth;
421 {
422 Lisp_Object pending_maps = Qnil;
423 Lisp_Object tail, item;
424 struct gcpro gcpro1, gcpro2;
425 int notbuttons = 0;
426
427 if (maxdepth <= 0)
428 return;
429
430 push_menu_pane (pane_name, prefix);
431
432 #ifndef HAVE_BOXES
433 /* Remember index for first item in this pane so we can go back and
434 add a prefix when (if) we see the first button. After that, notbuttons
435 is set to 0, to mark that we have seen a button and all non button
436 items need a prefix. */
437 notbuttons = menu_items_used;
438 #endif
439
440 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
441 {
442 GCPRO2 (keymap, pending_maps);
443 /* Look at each key binding, and if it is a menu item add it
444 to this menu. */
445 item = XCAR (tail);
446 if (CONSP (item))
447 single_menu_item (XCAR (item), XCDR (item),
448 &pending_maps, notreal, maxdepth, &notbuttons);
449 else if (VECTORP (item))
450 {
451 /* Loop over the char values represented in the vector. */
452 int len = XVECTOR (item)->size;
453 int c;
454 for (c = 0; c < len; c++)
455 {
456 Lisp_Object character;
457 XSETFASTINT (character, c);
458 single_menu_item (character, XVECTOR (item)->contents[c],
459 &pending_maps, notreal, maxdepth, &notbuttons);
460 }
461 }
462 UNGCPRO;
463 }
464
465 /* Process now any submenus which want to be panes at this level. */
466 while (!NILP (pending_maps))
467 {
468 Lisp_Object elt, eltcdr, string;
469 elt = Fcar (pending_maps);
470 eltcdr = XCDR (elt);
471 string = XCAR (eltcdr);
472 /* We no longer discard the @ from the beginning of the string here.
473 Instead, we do this in xmenu_show. */
474 single_keymap_panes (Fcar (elt), string,
475 XCDR (eltcdr), notreal, maxdepth - 1);
476 pending_maps = Fcdr (pending_maps);
477 }
478 }
479 \f
480 /* This is a subroutine of single_keymap_panes that handles one
481 keymap entry.
482 KEY is a key in a keymap and ITEM is its binding.
483 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
484 separate panes.
485 If NOTREAL is nonzero, only check for equivalent key bindings, don't
486 evaluate expressions in menu items and don't make any menu.
487 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
488 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
489 buttons. It points to variable notbuttons in single_keymap_panes,
490 which keeps track of if we have seen a button in this menu or not. */
491
492 static void
493 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth,
494 notbuttons_ptr)
495 Lisp_Object key, item;
496 Lisp_Object *pending_maps_ptr;
497 int maxdepth, notreal;
498 int *notbuttons_ptr;
499 {
500 Lisp_Object map, item_string, enabled;
501 struct gcpro gcpro1, gcpro2;
502 int res;
503
504 /* Parse the menu item and leave the result in item_properties. */
505 GCPRO2 (key, item);
506 res = parse_menu_item (item, notreal, 0);
507 UNGCPRO;
508 if (!res)
509 return; /* Not a menu item. */
510
511 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
512
513 if (notreal)
514 {
515 /* We don't want to make a menu, just traverse the keymaps to
516 precompute equivalent key bindings. */
517 if (!NILP (map))
518 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
519 return;
520 }
521
522 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
523 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
524
525 if (!NILP (map) && SREF (item_string, 0) == '@')
526 {
527 if (!NILP (enabled))
528 /* An enabled separate pane. Remember this to handle it later. */
529 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
530 *pending_maps_ptr);
531 return;
532 }
533
534 #ifndef HAVE_BOXES
535 /* Simulate radio buttons and toggle boxes by putting a prefix in
536 front of them. */
537 {
538 Lisp_Object prefix = Qnil;
539 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
540 if (!NILP (type))
541 {
542 Lisp_Object selected
543 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
544
545 if (*notbuttons_ptr)
546 /* The first button. Line up previous items in this menu. */
547 {
548 int index = *notbuttons_ptr; /* Index for first item this menu. */
549 int submenu = 0;
550 Lisp_Object tem;
551 while (index < menu_items_used)
552 {
553 tem
554 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
555 if (NILP (tem))
556 {
557 index++;
558 submenu++; /* Skip sub menu. */
559 }
560 else if (EQ (tem, Qlambda))
561 {
562 index++;
563 submenu--; /* End sub menu. */
564 }
565 else if (EQ (tem, Qt))
566 index += 3; /* Skip new pane marker. */
567 else if (EQ (tem, Qquote))
568 index++; /* Skip a left, right divider. */
569 else
570 {
571 if (!submenu && SREF (tem, 0) != '\0'
572 && SREF (tem, 0) != '-')
573 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
574 = concat2 (build_string (" "), tem);
575 index += MENU_ITEMS_ITEM_LENGTH;
576 }
577 }
578 *notbuttons_ptr = 0;
579 }
580
581 /* Calculate prefix, if any, for this item. */
582 if (EQ (type, QCtoggle))
583 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
584 else if (EQ (type, QCradio))
585 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
586 }
587 /* Not a button. If we have earlier buttons, then we need a prefix. */
588 else if (!*notbuttons_ptr && SREF (item_string, 0) != '\0'
589 && SREF (item_string, 0) != '-')
590 prefix = build_string (" ");
591
592 if (!NILP (prefix))
593 item_string = concat2 (prefix, item_string);
594 }
595 #endif /* not HAVE_BOXES */
596
597 #ifndef USE_X_TOOLKIT
598 if (!NILP(map))
599 /* Indicate visually that this is a submenu. */
600 item_string = concat2 (item_string, build_string (" >"));
601 #endif
602
603 push_menu_item (item_string, enabled, key,
604 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
605 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
606 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
607 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
608 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
609
610 #ifdef USE_X_TOOLKIT
611 /* Display a submenu using the toolkit. */
612 if (! (NILP (map) || NILP (enabled)))
613 {
614 push_submenu_start ();
615 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
616 push_submenu_end ();
617 }
618 #endif
619 }
620 \f
621 /* Push all the panes and items of a menu described by the
622 alist-of-alists MENU.
623 This handles old-fashioned calls to x-popup-menu. */
624
625 static void
626 list_of_panes (menu)
627 Lisp_Object menu;
628 {
629 Lisp_Object tail;
630
631 init_menu_items ();
632
633 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
634 {
635 Lisp_Object elt, pane_name, pane_data;
636 elt = Fcar (tail);
637 pane_name = Fcar (elt);
638 CHECK_STRING (pane_name);
639 push_menu_pane (pane_name, Qnil);
640 pane_data = Fcdr (elt);
641 CHECK_CONS (pane_data);
642 list_of_items (pane_data);
643 }
644
645 finish_menu_items ();
646 }
647
648 /* Push the items in a single pane defined by the alist PANE. */
649
650 static void
651 list_of_items (pane)
652 Lisp_Object pane;
653 {
654 Lisp_Object tail, item, item1;
655
656 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
657 {
658 item = Fcar (tail);
659 if (STRINGP (item))
660 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
661 else if (NILP (item))
662 push_left_right_boundary ();
663 else
664 {
665 CHECK_CONS (item);
666 item1 = Fcar (item);
667 CHECK_STRING (item1);
668 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
669 }
670 }
671 }
672 \f
673 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
674 doc: /* Pop up a deck-of-cards menu and return user's selection.
675 POSITION is a position specification. This is either a mouse button event
676 or a list ((XOFFSET YOFFSET) WINDOW)
677 where XOFFSET and YOFFSET are positions in pixels from the top left
678 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)
679 This controls the position of the center of the first line
680 in the first pane of the menu, not the top left of the menu as a whole.
681 If POSITION is t, it means to use the current mouse position.
682
683 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
684 The menu items come from key bindings that have a menu string as well as
685 a definition; actually, the "definition" in such a key binding looks like
686 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
687 the keymap as a top-level element.
688
689 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
690 Otherwise, REAL-DEFINITION should be a valid key binding definition.
691
692 You can also use a list of keymaps as MENU.
693 Then each keymap makes a separate pane.
694 When MENU is a keymap or a list of keymaps, the return value
695 is a list of events.
696
697 Alternatively, you can specify a menu of multiple panes
698 with a list of the form (TITLE PANE1 PANE2...),
699 where each pane is a list of form (TITLE ITEM1 ITEM2...).
700 Each ITEM is normally a cons cell (STRING . VALUE);
701 but a string can appear as an item--that makes a nonselectable line
702 in the menu.
703 With this form of menu, the return value is VALUE from the chosen item.
704
705 If POSITION is nil, don't display the menu at all, just precalculate the
706 cached information about equivalent key sequences. */)
707 (position, menu)
708 Lisp_Object position, menu;
709 {
710 Lisp_Object keymap, tem;
711 int xpos = 0, ypos = 0;
712 Lisp_Object title;
713 char *error_name;
714 Lisp_Object selection;
715 FRAME_PTR f = NULL;
716 Lisp_Object x, y, window;
717 int keymaps = 0;
718 int for_click = 0;
719 int specpdl_count = SPECPDL_INDEX ();
720 struct gcpro gcpro1;
721
722 #ifdef HAVE_MENUS
723 if (! NILP (position))
724 {
725 check_x ();
726
727 /* Decode the first argument: find the window and the coordinates. */
728 if (EQ (position, Qt)
729 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
730 || EQ (XCAR (position), Qtool_bar))))
731 {
732 /* Use the mouse's current position. */
733 FRAME_PTR new_f = SELECTED_FRAME ();
734 Lisp_Object bar_window;
735 enum scroll_bar_part part;
736 unsigned long time;
737
738 if (mouse_position_hook)
739 (*mouse_position_hook) (&new_f, 1, &bar_window,
740 &part, &x, &y, &time);
741 if (new_f != 0)
742 XSETFRAME (window, new_f);
743 else
744 {
745 window = selected_window;
746 XSETFASTINT (x, 0);
747 XSETFASTINT (y, 0);
748 }
749 }
750 else
751 {
752 tem = Fcar (position);
753 if (CONSP (tem))
754 {
755 window = Fcar (Fcdr (position));
756 x = Fcar (tem);
757 y = Fcar (Fcdr (tem));
758 }
759 else
760 {
761 for_click = 1;
762 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
763 window = Fcar (tem); /* POSN_WINDOW (tem) */
764 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
765 x = Fcar (tem);
766 y = Fcdr (tem);
767 }
768 }
769
770 CHECK_NUMBER (x);
771 CHECK_NUMBER (y);
772
773 /* Decode where to put the menu. */
774
775 if (FRAMEP (window))
776 {
777 f = XFRAME (window);
778 xpos = 0;
779 ypos = 0;
780 }
781 else if (WINDOWP (window))
782 {
783 CHECK_LIVE_WINDOW (window);
784 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
785
786 xpos = (FONT_WIDTH (FRAME_FONT (f))
787 * XFASTINT (XWINDOW (window)->left));
788 ypos = (FRAME_LINE_HEIGHT (f)
789 * XFASTINT (XWINDOW (window)->top));
790 }
791 else
792 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
793 but I don't want to make one now. */
794 CHECK_WINDOW (window);
795
796 xpos += XINT (x);
797 ypos += XINT (y);
798 }
799 Vmenu_updating_frame = Qnil;
800 #endif /* HAVE_MENUS */
801
802 record_unwind_protect (unuse_menu_items, Qnil);
803 title = Qnil;
804 GCPRO1 (title);
805
806 /* Decode the menu items from what was specified. */
807
808 keymap = get_keymap (menu, 0, 0);
809 if (CONSP (keymap))
810 {
811 /* We were given a keymap. Extract menu info from the keymap. */
812 Lisp_Object prompt;
813
814 /* Extract the detailed info to make one pane. */
815 keymap_panes (&menu, 1, NILP (position));
816
817 /* Search for a string appearing directly as an element of the keymap.
818 That string is the title of the menu. */
819 prompt = Fkeymap_prompt (keymap);
820 if (NILP (title) && !NILP (prompt))
821 title = prompt;
822
823 /* Make that be the pane title of the first pane. */
824 if (!NILP (prompt) && menu_items_n_panes >= 0)
825 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
826
827 keymaps = 1;
828 }
829 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
830 {
831 /* We were given a list of keymaps. */
832 int nmaps = XFASTINT (Flength (menu));
833 Lisp_Object *maps
834 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
835 int i;
836
837 title = Qnil;
838
839 /* The first keymap that has a prompt string
840 supplies the menu title. */
841 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
842 {
843 Lisp_Object prompt;
844
845 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
846
847 prompt = Fkeymap_prompt (keymap);
848 if (NILP (title) && !NILP (prompt))
849 title = prompt;
850 }
851
852 /* Extract the detailed info to make one pane. */
853 keymap_panes (maps, nmaps, NILP (position));
854
855 /* Make the title be the pane title of the first pane. */
856 if (!NILP (title) && menu_items_n_panes >= 0)
857 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
858
859 keymaps = 1;
860 }
861 else
862 {
863 /* We were given an old-fashioned menu. */
864 title = Fcar (menu);
865 CHECK_STRING (title);
866
867 list_of_panes (Fcdr (menu));
868
869 keymaps = 0;
870 }
871
872 unbind_to (specpdl_count, Qnil);
873
874 if (NILP (position))
875 {
876 discard_menu_items ();
877 UNGCPRO;
878 return Qnil;
879 }
880
881 #ifdef HAVE_MENUS
882 /* Display them in a menu. */
883 BLOCK_INPUT;
884
885 selection = xmenu_show (f, xpos, ypos, for_click,
886 keymaps, title, &error_name);
887 UNBLOCK_INPUT;
888
889 discard_menu_items ();
890
891 UNGCPRO;
892 #endif /* HAVE_MENUS */
893
894 if (error_name) error (error_name);
895 return selection;
896 }
897
898 #ifdef HAVE_MENUS
899
900 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
901 doc: /* Pop up a dialog box and return user's selection.
902 POSITION specifies which frame to use.
903 This is normally a mouse button event or a window or frame.
904 If POSITION is t, it means to use the frame the mouse is on.
905 The dialog box appears in the middle of the specified frame.
906
907 CONTENTS specifies the alternatives to display in the dialog box.
908 It is a list of the form (TITLE ITEM1 ITEM2...).
909 Each ITEM is a cons cell (STRING . VALUE).
910 The return value is VALUE from the chosen item.
911
912 An ITEM may also be just a string--that makes a nonselectable item.
913 An ITEM may also be nil--that means to put all preceding items
914 on the left of the dialog box and all following items on the right.
915 \(By default, approximately half appear on each side.) */)
916 (position, contents)
917 Lisp_Object position, contents;
918 {
919 FRAME_PTR f = NULL;
920 Lisp_Object window;
921
922 check_x ();
923
924 /* Decode the first argument: find the window or frame to use. */
925 if (EQ (position, Qt)
926 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
927 || EQ (XCAR (position), Qtool_bar))))
928 {
929 #if 0 /* Using the frame the mouse is on may not be right. */
930 /* Use the mouse's current position. */
931 FRAME_PTR new_f = SELECTED_FRAME ();
932 Lisp_Object bar_window;
933 enum scroll_bar_part part;
934 unsigned long time;
935 Lisp_Object x, y;
936
937 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
938
939 if (new_f != 0)
940 XSETFRAME (window, new_f);
941 else
942 window = selected_window;
943 #endif
944 window = selected_window;
945 }
946 else if (CONSP (position))
947 {
948 Lisp_Object tem;
949 tem = Fcar (position);
950 if (CONSP (tem))
951 window = Fcar (Fcdr (position));
952 else
953 {
954 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
955 window = Fcar (tem); /* POSN_WINDOW (tem) */
956 }
957 }
958 else if (WINDOWP (position) || FRAMEP (position))
959 window = position;
960 else
961 window = Qnil;
962
963 /* Decode where to put the menu. */
964
965 if (FRAMEP (window))
966 f = XFRAME (window);
967 else if (WINDOWP (window))
968 {
969 CHECK_LIVE_WINDOW (window);
970 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
971 }
972 else
973 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
974 but I don't want to make one now. */
975 CHECK_WINDOW (window);
976
977 #ifndef USE_X_TOOLKIT
978 /* Display a menu with these alternatives
979 in the middle of frame F. */
980 {
981 Lisp_Object x, y, frame, newpos;
982 XSETFRAME (frame, f);
983 XSETINT (x, x_pixel_width (f) / 2);
984 XSETINT (y, x_pixel_height (f) / 2);
985 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
986
987 return Fx_popup_menu (newpos,
988 Fcons (Fcar (contents), Fcons (contents, Qnil)));
989 }
990 #else
991 {
992 Lisp_Object title;
993 char *error_name;
994 Lisp_Object selection;
995 int specpdl_count = SPECPDL_INDEX ();
996
997 /* Decode the dialog items from what was specified. */
998 title = Fcar (contents);
999 CHECK_STRING (title);
1000 record_unwind_protect (unuse_menu_items, Qnil);
1001
1002 list_of_panes (Fcons (contents, Qnil));
1003
1004 /* Display them in a dialog box. */
1005 BLOCK_INPUT;
1006 selection = xdialog_show (f, 0, title, &error_name);
1007 UNBLOCK_INPUT;
1008
1009 unbind_to (specpdl_count, Qnil);
1010 discard_menu_items ();
1011
1012 if (error_name) error (error_name);
1013 return selection;
1014 }
1015 #endif
1016 }
1017 \f
1018 #ifdef USE_X_TOOLKIT
1019
1020 /* Define a queue to save up for later unreading
1021 all X events that don't pertain to the menu. */
1022 struct event_queue
1023 {
1024 XEvent event;
1025 struct event_queue *next;
1026 };
1027
1028 /* It is ok that this queue is a static variable,
1029 because init_menu_items won't allow the menu mechanism
1030 to be entered recursively. */
1031 static struct event_queue *popup_get_selection_queue;
1032
1033 static Lisp_Object popup_get_selection_unwind ();
1034
1035 /* Loop in Xt until the menu pulldown or dialog popup has been
1036 popped down (deactivated). This is used for x-popup-menu
1037 and x-popup-dialog; it is not used for the menu bar.
1038
1039 If DO_TIMERS is nonzero, run timers.
1040
1041 NOTE: All calls to popup_get_selection should be protected
1042 with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */
1043
1044 static void
1045 popup_get_selection (initial_event, dpyinfo, id, do_timers)
1046 XEvent *initial_event;
1047 struct x_display_info *dpyinfo;
1048 LWLIB_ID id;
1049 int do_timers;
1050 {
1051 XEvent event;
1052 struct event_queue *queue_tmp;
1053 int count = SPECPDL_INDEX ();
1054
1055 popup_get_selection_queue = NULL;
1056
1057 record_unwind_protect (popup_get_selection_unwind, Qnil);
1058
1059 if (initial_event)
1060 event = *initial_event;
1061 else
1062 XtAppNextEvent (Xt_app_con, &event);
1063
1064 while (1)
1065 {
1066 /* Handle expose events for editor frames right away. */
1067 if (event.type == Expose)
1068 process_expose_from_menu (event);
1069 /* Make sure we don't consider buttons grabbed after menu goes.
1070 And make sure to deactivate for any ButtonRelease,
1071 even if XtDispatchEvent doesn't do that. */
1072 else if (event.type == ButtonRelease
1073 && dpyinfo->display == event.xbutton.display)
1074 {
1075 dpyinfo->grabbed &= ~(1 << event.xbutton.button);
1076 popup_activated_flag = 0;
1077 #ifdef USE_MOTIF /* Pretending that the event came from a
1078 Btn1Down seems the only way to convince Motif to
1079 activate its callbacks; setting the XmNmenuPost
1080 isn't working. --marcus@sysc.pdx.edu. */
1081 event.xbutton.button = 1;
1082 #endif
1083 }
1084 /* If the user presses a key, deactivate the menu.
1085 The user is likely to do that if we get wedged. */
1086 else if (event.type == KeyPress
1087 && dpyinfo->display == event.xbutton.display)
1088 {
1089 KeySym keysym = XLookupKeysym (&event.xkey, 0);
1090 if (!IsModifierKey (keysym))
1091 {
1092 popup_activated_flag = 0;
1093 break;
1094 }
1095 }
1096 /* Button presses outside the menu also pop it down. */
1097 else if (event.type == ButtonPress
1098 && event.xany.display == dpyinfo->display
1099 && x_any_window_to_frame (dpyinfo, event.xany.window))
1100 {
1101 popup_activated_flag = 0;
1102 break;
1103 }
1104
1105 /* Queue all events not for this popup,
1106 except for Expose, which we've already handled, and ButtonRelease.
1107 Note that the X window is associated with the frame if this
1108 is a menu bar popup, but not if it's a dialog box. So we use
1109 x_non_menubar_window_to_frame, not x_any_window_to_frame. */
1110 if (event.type != Expose
1111 && !(event.type == ButtonRelease
1112 && dpyinfo->display == event.xbutton.display)
1113 && (event.xany.display != dpyinfo->display
1114 || x_non_menubar_window_to_frame (dpyinfo, event.xany.window)))
1115 {
1116 queue_tmp = (struct event_queue *) xmalloc (sizeof *queue_tmp);
1117 queue_tmp->event = event;
1118 queue_tmp->next = popup_get_selection_queue;
1119 popup_get_selection_queue = queue_tmp;
1120 }
1121 else
1122 XtDispatchEvent (&event);
1123
1124 /* If the event deactivated the menu, we are finished. */
1125 if (!popup_activated_flag)
1126 break;
1127
1128 /* If we have no events to run, consider timers. */
1129 if (do_timers && !XtAppPending (Xt_app_con))
1130 timer_check (1);
1131
1132 XtAppNextEvent (Xt_app_con, &event);
1133 }
1134
1135 unbind_to (count, Qnil);
1136 }
1137
1138 /* Unread any events that popup_get_selection read but did not handle. */
1139
1140 static Lisp_Object
1141 popup_get_selection_unwind (ignore)
1142 Lisp_Object ignore;
1143 {
1144 while (popup_get_selection_queue != NULL)
1145 {
1146 struct event_queue *queue_tmp;
1147 queue_tmp = popup_get_selection_queue;
1148 XPutBackEvent (queue_tmp->event.xany.display, &queue_tmp->event);
1149 popup_get_selection_queue = queue_tmp->next;
1150 xfree ((char *)queue_tmp);
1151 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1152 interrupt_input_pending = 1;
1153 }
1154 }
1155
1156 /* Activate the menu bar of frame F.
1157 This is called from keyboard.c when it gets the
1158 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
1159
1160 To activate the menu bar, we use the X button-press event
1161 that was saved in saved_menu_event.
1162 That makes the toolkit do its thing.
1163
1164 But first we recompute the menu bar contents (the whole tree).
1165
1166 The reason for saving the button event until here, instead of
1167 passing it to the toolkit right away, is that we can safely
1168 execute Lisp code. */
1169
1170 void
1171 x_activate_menubar (f)
1172 FRAME_PTR f;
1173 {
1174 if (!f->output_data.x->saved_menu_event->type)
1175 return;
1176
1177 set_frame_menubar (f, 0, 1);
1178 BLOCK_INPUT;
1179 XtDispatchEvent (f->output_data.x->saved_menu_event);
1180 UNBLOCK_INPUT;
1181 #ifdef USE_MOTIF
1182 if (f->output_data.x->saved_menu_event->type == ButtonRelease)
1183 pending_menu_activation = 1;
1184 #endif
1185
1186 /* Ignore this if we get it a second time. */
1187 f->output_data.x->saved_menu_event->type = 0;
1188 }
1189
1190 /* Detect if a dialog or menu has been posted. */
1191
1192 int
1193 popup_activated ()
1194 {
1195 return popup_activated_flag;
1196 }
1197
1198 /* This callback is invoked when the user selects a menubar cascade
1199 pushbutton, but before the pulldown menu is posted. */
1200
1201 static void
1202 popup_activate_callback (widget, id, client_data)
1203 Widget widget;
1204 LWLIB_ID id;
1205 XtPointer client_data;
1206 {
1207 popup_activated_flag = 1;
1208 }
1209
1210 /* This callback is invoked when a dialog or menu is finished being
1211 used and has been unposted. */
1212
1213 static void
1214 popup_deactivate_callback (widget, id, client_data)
1215 Widget widget;
1216 LWLIB_ID id;
1217 XtPointer client_data;
1218 {
1219 popup_activated_flag = 0;
1220 }
1221
1222 /* Lwlib callback called when menu items are highlighted/unhighlighted
1223 while moving the mouse over them. WIDGET is the menu bar or menu
1224 popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to
1225 the widget_value structure for the menu item, or null in case of
1226 unhighlighting. */
1227
1228 void
1229 menu_highlight_callback (widget, id, call_data)
1230 Widget widget;
1231 LWLIB_ID id;
1232 void *call_data;
1233 {
1234 widget_value *wv = (widget_value *) call_data;
1235 struct frame *f;
1236 Lisp_Object frame, help;
1237
1238 help = wv ? wv->help : Qnil;
1239
1240 /* Determine the frame for the help event. */
1241 f = menubar_id_to_frame (id);
1242 if (f)
1243 {
1244 XSETFRAME (frame, f);
1245 kbd_buffer_store_help_event (frame, help);
1246 }
1247 else
1248 {
1249 /* WIDGET is the popup menu. It's parent is the frame's
1250 widget. See which frame that is. */
1251 Widget frame_widget = XtParent (widget);
1252 Lisp_Object tail;
1253
1254 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
1255 {
1256 frame = XCAR (tail);
1257 if (GC_FRAMEP (frame)
1258 && (f = XFRAME (frame),
1259 FRAME_X_P (f) && f->output_data.x->widget == frame_widget))
1260 break;
1261 }
1262
1263 show_help_echo (help, Qnil, Qnil, Qnil, 1);
1264 }
1265 }
1266
1267 /* This callback is called from the menu bar pulldown menu
1268 when the user makes a selection.
1269 Figure out what the user chose
1270 and put the appropriate events into the keyboard buffer. */
1271
1272 static void
1273 menubar_selection_callback (widget, id, client_data)
1274 Widget widget;
1275 LWLIB_ID id;
1276 XtPointer client_data;
1277 {
1278 Lisp_Object prefix, entry;
1279 FRAME_PTR f = menubar_id_to_frame (id);
1280 Lisp_Object vector;
1281 Lisp_Object *subprefix_stack;
1282 int submenu_depth = 0;
1283 int i;
1284
1285 if (!f)
1286 return;
1287 entry = Qnil;
1288 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1289 vector = f->menu_bar_vector;
1290 prefix = Qnil;
1291 i = 0;
1292 while (i < f->menu_bar_items_used)
1293 {
1294 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1295 {
1296 subprefix_stack[submenu_depth++] = prefix;
1297 prefix = entry;
1298 i++;
1299 }
1300 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1301 {
1302 prefix = subprefix_stack[--submenu_depth];
1303 i++;
1304 }
1305 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1306 {
1307 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1308 i += MENU_ITEMS_PANE_LENGTH;
1309 }
1310 else
1311 {
1312 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1313 /* The EMACS_INT cast avoids a warning. There's no problem
1314 as long as pointers have enough bits to hold small integers. */
1315 if ((int) (EMACS_INT) client_data == i)
1316 {
1317 int j;
1318 struct input_event buf;
1319 Lisp_Object frame;
1320
1321 XSETFRAME (frame, f);
1322 buf.kind = MENU_BAR_EVENT;
1323 buf.frame_or_window = frame;
1324 buf.arg = frame;
1325 kbd_buffer_store_event (&buf);
1326
1327 for (j = 0; j < submenu_depth; j++)
1328 if (!NILP (subprefix_stack[j]))
1329 {
1330 buf.kind = MENU_BAR_EVENT;
1331 buf.frame_or_window = frame;
1332 buf.arg = subprefix_stack[j];
1333 kbd_buffer_store_event (&buf);
1334 }
1335
1336 if (!NILP (prefix))
1337 {
1338 buf.kind = MENU_BAR_EVENT;
1339 buf.frame_or_window = frame;
1340 buf.arg = prefix;
1341 kbd_buffer_store_event (&buf);
1342 }
1343
1344 buf.kind = MENU_BAR_EVENT;
1345 buf.frame_or_window = frame;
1346 buf.arg = entry;
1347 kbd_buffer_store_event (&buf);
1348
1349 return;
1350 }
1351 i += MENU_ITEMS_ITEM_LENGTH;
1352 }
1353 }
1354 }
1355
1356 /* Allocate a widget_value, blocking input. */
1357
1358 widget_value *
1359 xmalloc_widget_value ()
1360 {
1361 widget_value *value;
1362
1363 BLOCK_INPUT;
1364 value = malloc_widget_value ();
1365 UNBLOCK_INPUT;
1366
1367 return value;
1368 }
1369
1370 /* This recursively calls free_widget_value on the tree of widgets.
1371 It must free all data that was malloc'ed for these widget_values.
1372 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1373 must be left alone. */
1374
1375 void
1376 free_menubar_widget_value_tree (wv)
1377 widget_value *wv;
1378 {
1379 if (! wv) return;
1380
1381 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1382
1383 if (wv->contents && (wv->contents != (widget_value*)1))
1384 {
1385 free_menubar_widget_value_tree (wv->contents);
1386 wv->contents = (widget_value *) 0xDEADBEEF;
1387 }
1388 if (wv->next)
1389 {
1390 free_menubar_widget_value_tree (wv->next);
1391 wv->next = (widget_value *) 0xDEADBEEF;
1392 }
1393 BLOCK_INPUT;
1394 free_widget_value (wv);
1395 UNBLOCK_INPUT;
1396 }
1397 \f
1398 /* Set up data in menu_items for a menu bar item
1399 whose event type is ITEM_KEY (with string ITEM_NAME)
1400 and whose contents come from the list of keymaps MAPS. */
1401
1402 static int
1403 parse_single_submenu (item_key, item_name, maps)
1404 Lisp_Object item_key, item_name, maps;
1405 {
1406 Lisp_Object length;
1407 int len;
1408 Lisp_Object *mapvec;
1409 int i;
1410 int top_level_items = 0;
1411
1412 length = Flength (maps);
1413 len = XINT (length);
1414
1415 /* Convert the list MAPS into a vector MAPVEC. */
1416 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1417 for (i = 0; i < len; i++)
1418 {
1419 mapvec[i] = Fcar (maps);
1420 maps = Fcdr (maps);
1421 }
1422
1423 /* Loop over the given keymaps, making a pane for each map.
1424 But don't make a pane that is empty--ignore that map instead. */
1425 for (i = 0; i < len; i++)
1426 {
1427 if (!KEYMAPP (mapvec[i]))
1428 {
1429 /* Here we have a command at top level in the menu bar
1430 as opposed to a submenu. */
1431 top_level_items = 1;
1432 push_menu_pane (Qnil, Qnil);
1433 push_menu_item (item_name, Qt, item_key, mapvec[i],
1434 Qnil, Qnil, Qnil, Qnil);
1435 }
1436 else
1437 {
1438 Lisp_Object prompt;
1439 prompt = Fkeymap_prompt (mapvec[i]);
1440 single_keymap_panes (mapvec[i],
1441 !NILP (prompt) ? prompt : item_name,
1442 item_key, 0, 10);
1443 }
1444 }
1445
1446 return top_level_items;
1447 }
1448
1449 /* Create a tree of widget_value objects
1450 representing the panes and items
1451 in menu_items starting at index START, up to index END. */
1452
1453 static widget_value *
1454 digest_single_submenu (start, end, top_level_items)
1455 int start, end, top_level_items;
1456 {
1457 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1458 int i;
1459 int submenu_depth = 0;
1460 widget_value **submenu_stack;
1461
1462 submenu_stack
1463 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1464 wv = xmalloc_widget_value ();
1465 wv->name = "menu";
1466 wv->value = 0;
1467 wv->enabled = 1;
1468 wv->button_type = BUTTON_TYPE_NONE;
1469 wv->help = Qnil;
1470 first_wv = wv;
1471 save_wv = 0;
1472 prev_wv = 0;
1473
1474 /* Loop over all panes and items made by the preceding call
1475 to parse_single_submenu and construct a tree of widget_value objects.
1476 Ignore the panes and items used by previous calls to
1477 digest_single_submenu, even though those are also in menu_items. */
1478 i = start;
1479 while (i < end)
1480 {
1481 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1482 {
1483 submenu_stack[submenu_depth++] = save_wv;
1484 save_wv = prev_wv;
1485 prev_wv = 0;
1486 i++;
1487 }
1488 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1489 {
1490 prev_wv = save_wv;
1491 save_wv = submenu_stack[--submenu_depth];
1492 i++;
1493 }
1494 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1495 && submenu_depth != 0)
1496 i += MENU_ITEMS_PANE_LENGTH;
1497 /* Ignore a nil in the item list.
1498 It's meaningful only for dialog boxes. */
1499 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1500 i += 1;
1501 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1502 {
1503 /* Create a new pane. */
1504 Lisp_Object pane_name, prefix;
1505 char *pane_string;
1506
1507 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1508 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1509
1510 #ifndef HAVE_MULTILINGUAL_MENU
1511 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1512 {
1513 pane_name = ENCODE_SYSTEM (pane_name);
1514 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1515 }
1516 #endif
1517 pane_string = (NILP (pane_name)
1518 ? "" : (char *) SDATA (pane_name));
1519 /* If there is just one top-level pane, put all its items directly
1520 under the top-level menu. */
1521 if (menu_items_n_panes == 1)
1522 pane_string = "";
1523
1524 /* If the pane has a meaningful name,
1525 make the pane a top-level menu item
1526 with its items as a submenu beneath it. */
1527 if (strcmp (pane_string, ""))
1528 {
1529 wv = xmalloc_widget_value ();
1530 if (save_wv)
1531 save_wv->next = wv;
1532 else
1533 first_wv->contents = wv;
1534 wv->name = pane_string;
1535 /* Ignore the @ that means "separate pane".
1536 This is a kludge, but this isn't worth more time. */
1537 if (!NILP (prefix) && wv->name[0] == '@')
1538 wv->name++;
1539 wv->value = 0;
1540 wv->enabled = 1;
1541 wv->button_type = BUTTON_TYPE_NONE;
1542 wv->help = Qnil;
1543 }
1544 save_wv = wv;
1545 prev_wv = 0;
1546 i += MENU_ITEMS_PANE_LENGTH;
1547 }
1548 else
1549 {
1550 /* Create a new item within current pane. */
1551 Lisp_Object item_name, enable, descrip, def, type, selected;
1552 Lisp_Object help;
1553
1554 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1555 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1556 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1557 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1558 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1559 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1560 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1561
1562 #ifndef HAVE_MULTILINGUAL_MENU
1563 if (STRING_MULTIBYTE (item_name))
1564 {
1565 item_name = ENCODE_SYSTEM (item_name);
1566 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1567 }
1568
1569 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1570 {
1571 descrip = ENCODE_SYSTEM (descrip);
1572 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1573 }
1574 #endif /* not HAVE_MULTILINGUAL_MENU */
1575
1576 wv = xmalloc_widget_value ();
1577 if (prev_wv)
1578 prev_wv->next = wv;
1579 else
1580 save_wv->contents = wv;
1581
1582 wv->name = (char *) SDATA (item_name);
1583 if (!NILP (descrip))
1584 wv->key = (char *) SDATA (descrip);
1585 wv->value = 0;
1586 /* The EMACS_INT cast avoids a warning. There's no problem
1587 as long as pointers have enough bits to hold small integers. */
1588 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1589 wv->enabled = !NILP (enable);
1590
1591 if (NILP (type))
1592 wv->button_type = BUTTON_TYPE_NONE;
1593 else if (EQ (type, QCradio))
1594 wv->button_type = BUTTON_TYPE_RADIO;
1595 else if (EQ (type, QCtoggle))
1596 wv->button_type = BUTTON_TYPE_TOGGLE;
1597 else
1598 abort ();
1599
1600 wv->selected = !NILP (selected);
1601 if (! STRINGP (help))
1602 help = Qnil;
1603
1604 wv->help = help;
1605
1606 prev_wv = wv;
1607
1608 i += MENU_ITEMS_ITEM_LENGTH;
1609 }
1610 }
1611
1612 /* If we have just one "menu item"
1613 that was originally a button, return it by itself. */
1614 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1615 {
1616 wv = first_wv->contents;
1617 free_widget_value (first_wv);
1618 return wv;
1619 }
1620
1621 return first_wv;
1622 }
1623 \f
1624 /* Recompute all the widgets of frame F, when the menu bar has been
1625 changed. Value is non-zero if widgets were updated. */
1626
1627 static int
1628 update_frame_menubar (f)
1629 FRAME_PTR f;
1630 {
1631 struct x_output *x = f->output_data.x;
1632 int columns, rows;
1633
1634 if (!x->menubar_widget || XtIsManaged (x->menubar_widget))
1635 return 0;
1636
1637 BLOCK_INPUT;
1638 /* Save the size of the frame because the pane widget doesn't accept
1639 to resize itself. So force it. */
1640 columns = f->width;
1641 rows = f->height;
1642
1643 /* Do the voodoo which means "I'm changing lots of things, don't try
1644 to refigure sizes until I'm done." */
1645 lw_refigure_widget (x->column_widget, False);
1646
1647 /* The order in which children are managed is the top to bottom
1648 order in which they are displayed in the paned window. First,
1649 remove the text-area widget. */
1650 XtUnmanageChild (x->edit_widget);
1651
1652 /* Remove the menubar that is there now, and put up the menubar that
1653 should be there. */
1654 XtManageChild (x->menubar_widget);
1655 XtMapWidget (x->menubar_widget);
1656 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, NULL);
1657
1658 /* Re-manage the text-area widget, and then thrash the sizes. */
1659 XtManageChild (x->edit_widget);
1660 lw_refigure_widget (x->column_widget, True);
1661
1662 /* Force the pane widget to resize itself with the right values. */
1663 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1664 UNBLOCK_INPUT;
1665 return 1;
1666 }
1667
1668 /* Set the contents of the menubar widgets of frame F.
1669 The argument FIRST_TIME is currently ignored;
1670 it is set the first time this is called, from initialize_frame_menubar. */
1671
1672 void
1673 set_frame_menubar (f, first_time, deep_p)
1674 FRAME_PTR f;
1675 int first_time;
1676 int deep_p;
1677 {
1678 Widget menubar_widget = f->output_data.x->menubar_widget;
1679 Lisp_Object items;
1680 widget_value *wv, *first_wv, *prev_wv = 0;
1681 int i, last_i;
1682 int *submenu_start, *submenu_end;
1683 int *submenu_top_level_items, *submenu_n_panes;
1684
1685 LWLIB_ID id;
1686
1687 XSETFRAME (Vmenu_updating_frame, f);
1688
1689 if (f->output_data.x->id == 0)
1690 f->output_data.x->id = next_menubar_widget_id++;
1691 id = f->output_data.x->id;
1692
1693 if (! menubar_widget)
1694 deep_p = 1;
1695 else if (pending_menu_activation && !deep_p)
1696 deep_p = 1;
1697 /* Make the first call for any given frame always go deep. */
1698 else if (!f->output_data.x->saved_menu_event && !deep_p)
1699 {
1700 deep_p = 1;
1701 f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent));
1702 f->output_data.x->saved_menu_event->type = 0;
1703 }
1704
1705 if (deep_p)
1706 {
1707 /* Make a widget-value tree representing the entire menu trees. */
1708
1709 struct buffer *prev = current_buffer;
1710 Lisp_Object buffer;
1711 int specpdl_count = SPECPDL_INDEX ();
1712 int previous_menu_items_used = f->menu_bar_items_used;
1713 Lisp_Object *previous_items
1714 = (Lisp_Object *) alloca (previous_menu_items_used
1715 * sizeof (Lisp_Object));
1716
1717 /* If we are making a new widget, its contents are empty,
1718 do always reinitialize them. */
1719 if (! menubar_widget)
1720 previous_menu_items_used = 0;
1721
1722 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1723 specbind (Qinhibit_quit, Qt);
1724 /* Don't let the debugger step into this code
1725 because it is not reentrant. */
1726 specbind (Qdebug_on_next_call, Qnil);
1727
1728 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1729 record_unwind_protect (unuse_menu_items, Qnil);
1730 if (NILP (Voverriding_local_map_menu_flag))
1731 {
1732 specbind (Qoverriding_terminal_local_map, Qnil);
1733 specbind (Qoverriding_local_map, Qnil);
1734 }
1735
1736 set_buffer_internal_1 (XBUFFER (buffer));
1737
1738 /* Run the Lucid hook. */
1739 safe_run_hooks (Qactivate_menubar_hook);
1740
1741 /* If it has changed current-menubar from previous value,
1742 really recompute the menubar from the value. */
1743 if (! NILP (Vlucid_menu_bar_dirty_flag))
1744 call0 (Qrecompute_lucid_menubar);
1745 safe_run_hooks (Qmenu_bar_update_hook);
1746 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1747
1748 items = FRAME_MENU_BAR_ITEMS (f);
1749
1750 /* Save the frame's previous menu bar contents data. */
1751 if (previous_menu_items_used)
1752 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1753 previous_menu_items_used * sizeof (Lisp_Object));
1754
1755 /* Fill in menu_items with the current menu bar contents.
1756 This can evaluate Lisp code. */
1757 menu_items = f->menu_bar_vector;
1758 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1759 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1760 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1761 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1762 submenu_top_level_items
1763 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1764 init_menu_items ();
1765 for (i = 0; i < XVECTOR (items)->size; i += 4)
1766 {
1767 Lisp_Object key, string, maps;
1768
1769 last_i = i;
1770
1771 key = XVECTOR (items)->contents[i];
1772 string = XVECTOR (items)->contents[i + 1];
1773 maps = XVECTOR (items)->contents[i + 2];
1774 if (NILP (string))
1775 break;
1776
1777 submenu_start[i] = menu_items_used;
1778
1779 menu_items_n_panes = 0;
1780 submenu_top_level_items[i]
1781 = parse_single_submenu (key, string, maps);
1782 submenu_n_panes[i] = menu_items_n_panes;
1783
1784 submenu_end[i] = menu_items_used;
1785 }
1786
1787 finish_menu_items ();
1788
1789 /* Convert menu_items into widget_value trees
1790 to display the menu. This cannot evaluate Lisp code. */
1791
1792 wv = xmalloc_widget_value ();
1793 wv->name = "menubar";
1794 wv->value = 0;
1795 wv->enabled = 1;
1796 wv->button_type = BUTTON_TYPE_NONE;
1797 wv->help = Qnil;
1798 first_wv = wv;
1799
1800 for (i = 0; i < last_i; i += 4)
1801 {
1802 menu_items_n_panes = submenu_n_panes[i];
1803 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1804 submenu_top_level_items[i]);
1805 if (prev_wv)
1806 prev_wv->next = wv;
1807 else
1808 first_wv->contents = wv;
1809 /* Don't set wv->name here; GC during the loop might relocate it. */
1810 wv->enabled = 1;
1811 wv->button_type = BUTTON_TYPE_NONE;
1812 prev_wv = wv;
1813 }
1814
1815 set_buffer_internal_1 (prev);
1816 unbind_to (specpdl_count, Qnil);
1817
1818 /* If there has been no change in the Lisp-level contents
1819 of the menu bar, skip redisplaying it. Just exit. */
1820
1821 for (i = 0; i < previous_menu_items_used; i++)
1822 if (menu_items_used == i
1823 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1824 break;
1825 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1826 {
1827 free_menubar_widget_value_tree (first_wv);
1828 discard_menu_items ();
1829
1830 return;
1831 }
1832
1833 /* Now GC cannot happen during the lifetime of the widget_value,
1834 so it's safe to store data from a Lisp_String. */
1835 wv = first_wv->contents;
1836 for (i = 0; i < XVECTOR (items)->size; i += 4)
1837 {
1838 Lisp_Object string;
1839 string = XVECTOR (items)->contents[i + 1];
1840 if (NILP (string))
1841 break;
1842 wv->name = (char *) SDATA (string);
1843 wv = wv->next;
1844 }
1845
1846 f->menu_bar_vector = menu_items;
1847 f->menu_bar_items_used = menu_items_used;
1848 discard_menu_items ();
1849 }
1850 else
1851 {
1852 /* Make a widget-value tree containing
1853 just the top level menu bar strings. */
1854
1855 wv = xmalloc_widget_value ();
1856 wv->name = "menubar";
1857 wv->value = 0;
1858 wv->enabled = 1;
1859 wv->button_type = BUTTON_TYPE_NONE;
1860 wv->help = Qnil;
1861 first_wv = wv;
1862
1863 items = FRAME_MENU_BAR_ITEMS (f);
1864 for (i = 0; i < XVECTOR (items)->size; i += 4)
1865 {
1866 Lisp_Object string;
1867
1868 string = XVECTOR (items)->contents[i + 1];
1869 if (NILP (string))
1870 break;
1871
1872 wv = xmalloc_widget_value ();
1873 wv->name = (char *) SDATA (string);
1874 wv->value = 0;
1875 wv->enabled = 1;
1876 wv->button_type = BUTTON_TYPE_NONE;
1877 wv->help = Qnil;
1878 /* This prevents lwlib from assuming this
1879 menu item is really supposed to be empty. */
1880 /* The EMACS_INT cast avoids a warning.
1881 This value just has to be different from small integers. */
1882 wv->call_data = (void *) (EMACS_INT) (-1);
1883
1884 if (prev_wv)
1885 prev_wv->next = wv;
1886 else
1887 first_wv->contents = wv;
1888 prev_wv = wv;
1889 }
1890
1891 /* Forget what we thought we knew about what is in the
1892 detailed contents of the menu bar menus.
1893 Changing the top level always destroys the contents. */
1894 f->menu_bar_items_used = 0;
1895 }
1896
1897 /* Create or update the menu bar widget. */
1898
1899 BLOCK_INPUT;
1900
1901 if (menubar_widget)
1902 {
1903 /* Disable resizing (done for Motif!) */
1904 lw_allow_resizing (f->output_data.x->widget, False);
1905
1906 /* The third arg is DEEP_P, which says to consider the entire
1907 menu trees we supply, rather than just the menu bar item names. */
1908 lw_modify_all_widgets (id, first_wv, deep_p);
1909
1910 /* Re-enable the edit widget to resize. */
1911 lw_allow_resizing (f->output_data.x->widget, True);
1912 }
1913 else
1914 {
1915 menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv,
1916 f->output_data.x->column_widget,
1917 0,
1918 popup_activate_callback,
1919 menubar_selection_callback,
1920 popup_deactivate_callback,
1921 menu_highlight_callback);
1922 f->output_data.x->menubar_widget = menubar_widget;
1923 }
1924
1925 {
1926 int menubar_size
1927 = (f->output_data.x->menubar_widget
1928 ? (f->output_data.x->menubar_widget->core.height
1929 + f->output_data.x->menubar_widget->core.border_width)
1930 : 0);
1931
1932 #if 0 /* Experimentally, we now get the right results
1933 for -geometry -0-0 without this. 24 Aug 96, rms. */
1934 #ifdef USE_LUCID
1935 if (FRAME_EXTERNAL_MENU_BAR (f))
1936 {
1937 Dimension ibw = 0;
1938 XtVaGetValues (f->output_data.x->column_widget,
1939 XtNinternalBorderWidth, &ibw, NULL);
1940 menubar_size += ibw;
1941 }
1942 #endif /* USE_LUCID */
1943 #endif /* 0 */
1944
1945 f->output_data.x->menubar_height = menubar_size;
1946 }
1947
1948 free_menubar_widget_value_tree (first_wv);
1949 update_frame_menubar (f);
1950
1951 UNBLOCK_INPUT;
1952 }
1953
1954 /* Called from Fx_create_frame to create the initial menubar of a frame
1955 before it is mapped, so that the window is mapped with the menubar already
1956 there instead of us tacking it on later and thrashing the window after it
1957 is visible. */
1958
1959 void
1960 initialize_frame_menubar (f)
1961 FRAME_PTR f;
1962 {
1963 /* This function is called before the first chance to redisplay
1964 the frame. It has to be, so the frame will have the right size. */
1965 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1966 set_frame_menubar (f, 1, 1);
1967 }
1968
1969
1970 /* Get rid of the menu bar of frame F, and free its storage.
1971 This is used when deleting a frame, and when turning off the menu bar. */
1972
1973 void
1974 free_frame_menubar (f)
1975 FRAME_PTR f;
1976 {
1977 Widget menubar_widget;
1978
1979 menubar_widget = f->output_data.x->menubar_widget;
1980
1981 f->output_data.x->menubar_height = 0;
1982
1983 if (menubar_widget)
1984 {
1985 #ifdef USE_MOTIF
1986 /* Removing the menu bar magically changes the shell widget's x
1987 and y position of (0, 0) which, when the menu bar is turned
1988 on again, leads to pull-down menuss appearing in strange
1989 positions near the upper-left corner of the display. This
1990 happens only with some window managers like twm and ctwm,
1991 but not with other like Motif's mwm or kwm, because the
1992 latter generate ConfigureNotify events when the menu bar
1993 is switched off, which fixes the shell position. */
1994 Position x0, y0, x1, y1;
1995 #endif
1996
1997 BLOCK_INPUT;
1998
1999 #ifdef USE_MOTIF
2000 if (f->output_data.x->widget)
2001 XtVaGetValues (f->output_data.x->widget, XtNx, &x0, XtNy, &y0, NULL);
2002 #endif
2003
2004 lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
2005 f->output_data.x->menubar_widget = NULL;
2006
2007 #ifdef USE_MOTIF
2008 if (f->output_data.x->widget)
2009 {
2010 XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL);
2011 if (x1 == 0 && y1 == 0)
2012 XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL);
2013 }
2014 #endif
2015
2016 UNBLOCK_INPUT;
2017 }
2018 }
2019
2020 #endif /* USE_X_TOOLKIT */
2021 \f
2022 /* xmenu_show actually displays a menu using the panes and items in menu_items
2023 and returns the value selected from it.
2024 There are two versions of xmenu_show, one for Xt and one for Xlib.
2025 Both assume input is blocked by the caller. */
2026
2027 /* F is the frame the menu is for.
2028 X and Y are the frame-relative specified position,
2029 relative to the inside upper left corner of the frame F.
2030 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
2031 KEYMAPS is 1 if this menu was specified with keymaps;
2032 in that case, we return a list containing the chosen item's value
2033 and perhaps also the pane's prefix.
2034 TITLE is the specified menu title.
2035 ERROR is a place to store an error message string in case of failure.
2036 (We return nil on failure, but the value doesn't actually matter.) */
2037
2038 #ifdef USE_X_TOOLKIT
2039
2040 /* We need a unique id for each widget handled by the Lucid Widget
2041 library.
2042
2043 For the main windows, and popup menus, we use this counter,
2044 which we increment each time after use. This starts from 1<<16.
2045
2046 For menu bars, we use numbers starting at 0, counted in
2047 next_menubar_widget_id. */
2048 LWLIB_ID widget_id_tick;
2049
2050 static Lisp_Object *volatile menu_item_selection;
2051
2052 static void
2053 popup_selection_callback (widget, id, client_data)
2054 Widget widget;
2055 LWLIB_ID id;
2056 XtPointer client_data;
2057 {
2058 menu_item_selection = (Lisp_Object *) client_data;
2059 }
2060
2061 static Lisp_Object
2062 xmenu_show (f, x, y, for_click, keymaps, title, error)
2063 FRAME_PTR f;
2064 int x;
2065 int y;
2066 int for_click;
2067 int keymaps;
2068 Lisp_Object title;
2069 char **error;
2070 {
2071 int i;
2072 LWLIB_ID menu_id;
2073 Widget menu;
2074 Arg av[2];
2075 int ac = 0;
2076 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
2077 widget_value **submenu_stack
2078 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
2079 Lisp_Object *subprefix_stack
2080 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
2081 int submenu_depth = 0;
2082 XButtonPressedEvent dummy;
2083
2084 int first_pane;
2085
2086 *error = NULL;
2087
2088 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2089 {
2090 *error = "Empty menu";
2091 return Qnil;
2092 }
2093
2094 /* Create a tree of widget_value objects
2095 representing the panes and their items. */
2096 wv = xmalloc_widget_value ();
2097 wv->name = "menu";
2098 wv->value = 0;
2099 wv->enabled = 1;
2100 wv->button_type = BUTTON_TYPE_NONE;
2101 wv->help =Qnil;
2102 first_wv = wv;
2103 first_pane = 1;
2104
2105 /* Loop over all panes and items, filling in the tree. */
2106 i = 0;
2107 while (i < menu_items_used)
2108 {
2109 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2110 {
2111 submenu_stack[submenu_depth++] = save_wv;
2112 save_wv = prev_wv;
2113 prev_wv = 0;
2114 first_pane = 1;
2115 i++;
2116 }
2117 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2118 {
2119 prev_wv = save_wv;
2120 save_wv = submenu_stack[--submenu_depth];
2121 first_pane = 0;
2122 i++;
2123 }
2124 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
2125 && submenu_depth != 0)
2126 i += MENU_ITEMS_PANE_LENGTH;
2127 /* Ignore a nil in the item list.
2128 It's meaningful only for dialog boxes. */
2129 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2130 i += 1;
2131 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2132 {
2133 /* Create a new pane. */
2134 Lisp_Object pane_name, prefix;
2135 char *pane_string;
2136
2137 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
2138 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2139
2140 #ifndef HAVE_MULTILINGUAL_MENU
2141 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
2142 {
2143 pane_name = ENCODE_SYSTEM (pane_name);
2144 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
2145 }
2146 #endif
2147 pane_string = (NILP (pane_name)
2148 ? "" : (char *) SDATA (pane_name));
2149 /* If there is just one top-level pane, put all its items directly
2150 under the top-level menu. */
2151 if (menu_items_n_panes == 1)
2152 pane_string = "";
2153
2154 /* If the pane has a meaningful name,
2155 make the pane a top-level menu item
2156 with its items as a submenu beneath it. */
2157 if (!keymaps && strcmp (pane_string, ""))
2158 {
2159 wv = xmalloc_widget_value ();
2160 if (save_wv)
2161 save_wv->next = wv;
2162 else
2163 first_wv->contents = wv;
2164 wv->name = pane_string;
2165 if (keymaps && !NILP (prefix))
2166 wv->name++;
2167 wv->value = 0;
2168 wv->enabled = 1;
2169 wv->button_type = BUTTON_TYPE_NONE;
2170 wv->help = Qnil;
2171 save_wv = wv;
2172 prev_wv = 0;
2173 }
2174 else if (first_pane)
2175 {
2176 save_wv = wv;
2177 prev_wv = 0;
2178 }
2179 first_pane = 0;
2180 i += MENU_ITEMS_PANE_LENGTH;
2181 }
2182 else
2183 {
2184 /* Create a new item within current pane. */
2185 Lisp_Object item_name, enable, descrip, def, type, selected, help;
2186 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2187 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2188 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2189 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
2190 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
2191 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
2192 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2193
2194 #ifndef HAVE_MULTILINGUAL_MENU
2195 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
2196 {
2197 item_name = ENCODE_SYSTEM (item_name);
2198 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
2199 }
2200
2201 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
2202 {
2203 descrip = ENCODE_SYSTEM (descrip);
2204 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
2205 }
2206 #endif /* not HAVE_MULTILINGUAL_MENU */
2207
2208 wv = xmalloc_widget_value ();
2209 if (prev_wv)
2210 prev_wv->next = wv;
2211 else
2212 save_wv->contents = wv;
2213 wv->name = (char *) SDATA (item_name);
2214 if (!NILP (descrip))
2215 wv->key = (char *) SDATA (descrip);
2216 wv->value = 0;
2217 /* If this item has a null value,
2218 make the call_data null so that it won't display a box
2219 when the mouse is on it. */
2220 wv->call_data
2221 = (!NILP (def) ? (void *) &XVECTOR (menu_items)->contents[i] : 0);
2222 wv->enabled = !NILP (enable);
2223
2224 if (NILP (type))
2225 wv->button_type = BUTTON_TYPE_NONE;
2226 else if (EQ (type, QCtoggle))
2227 wv->button_type = BUTTON_TYPE_TOGGLE;
2228 else if (EQ (type, QCradio))
2229 wv->button_type = BUTTON_TYPE_RADIO;
2230 else
2231 abort ();
2232
2233 wv->selected = !NILP (selected);
2234
2235 if (! STRINGP (help))
2236 help = Qnil;
2237
2238 wv->help = help;
2239
2240 prev_wv = wv;
2241
2242 i += MENU_ITEMS_ITEM_LENGTH;
2243 }
2244 }
2245
2246 /* Deal with the title, if it is non-nil. */
2247 if (!NILP (title))
2248 {
2249 widget_value *wv_title = xmalloc_widget_value ();
2250 widget_value *wv_sep1 = xmalloc_widget_value ();
2251 widget_value *wv_sep2 = xmalloc_widget_value ();
2252
2253 wv_sep2->name = "--";
2254 wv_sep2->next = first_wv->contents;
2255 wv_sep2->help = Qnil;
2256
2257 wv_sep1->name = "--";
2258 wv_sep1->next = wv_sep2;
2259 wv_sep1->help = Qnil;
2260
2261 #ifndef HAVE_MULTILINGUAL_MENU
2262 if (STRING_MULTIBYTE (title))
2263 title = ENCODE_SYSTEM (title);
2264 #endif
2265
2266 wv_title->name = (char *) SDATA (title);
2267 wv_title->enabled = TRUE;
2268 wv_title->button_type = BUTTON_TYPE_NONE;
2269 wv_title->next = wv_sep1;
2270 wv_title->help = Qnil;
2271 first_wv->contents = wv_title;
2272 }
2273
2274 /* Actually create the menu. */
2275 menu_id = widget_id_tick++;
2276 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
2277 f->output_data.x->widget, 1, 0,
2278 popup_selection_callback,
2279 popup_deactivate_callback,
2280 menu_highlight_callback);
2281
2282 /* Adjust coordinates to relative to the outer (window manager) window. */
2283 {
2284 Window child;
2285 int win_x = 0, win_y = 0;
2286
2287 /* Find the position of the outside upper-left corner of
2288 the inner window, with respect to the outer window. */
2289 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2290 {
2291 BLOCK_INPUT;
2292 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2293
2294 /* From-window, to-window. */
2295 f->output_data.x->window_desc,
2296 f->output_data.x->parent_desc,
2297
2298 /* From-position, to-position. */
2299 0, 0, &win_x, &win_y,
2300
2301 /* Child of window. */
2302 &child);
2303 UNBLOCK_INPUT;
2304 x += win_x;
2305 y += win_y;
2306 }
2307 }
2308
2309 /* Adjust coordinates to be root-window-relative. */
2310 x += f->output_data.x->left_pos;
2311 y += f->output_data.x->top_pos;
2312
2313 dummy.type = ButtonPress;
2314 dummy.serial = 0;
2315 dummy.send_event = 0;
2316 dummy.display = FRAME_X_DISPLAY (f);
2317 dummy.time = CurrentTime;
2318 dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
2319 dummy.window = dummy.root;
2320 dummy.subwindow = dummy.root;
2321 dummy.x_root = x;
2322 dummy.y_root = y;
2323 dummy.x = x;
2324 dummy.y = y;
2325 dummy.state = (FRAME_X_DISPLAY_INFO (f)->grabbed >> 1) * Button1Mask;
2326 dummy.button = 0;
2327 for (i = 0; i < 5; i++)
2328 if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
2329 dummy.button = i;
2330
2331 /* Don't allow any geometry request from the user. */
2332 XtSetArg (av[ac], XtNgeometry, 0); ac++;
2333 XtSetValues (menu, av, ac);
2334
2335 /* Free the widget_value objects we used to specify the contents. */
2336 free_menubar_widget_value_tree (first_wv);
2337
2338 /* No selection has been chosen yet. */
2339 menu_item_selection = 0;
2340
2341 /* Display the menu. */
2342 lw_popup_menu (menu, (XEvent *) &dummy);
2343 popup_activated_flag = 1;
2344
2345 /* Process events that apply to the menu. */
2346 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0);
2347
2348 /* fp turned off the following statement and wrote a comment
2349 that it is unnecessary--that the menu has already disappeared.
2350 Nowadays the menu disappears ok, all right, but
2351 we need to delete the widgets or multiple ones will pile up. */
2352 lw_destroy_all_widgets (menu_id);
2353
2354 /* Find the selected item, and its pane, to return
2355 the proper value. */
2356 if (menu_item_selection != 0)
2357 {
2358 Lisp_Object prefix, entry;
2359
2360 prefix = entry = Qnil;
2361 i = 0;
2362 while (i < menu_items_used)
2363 {
2364 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
2365 {
2366 subprefix_stack[submenu_depth++] = prefix;
2367 prefix = entry;
2368 i++;
2369 }
2370 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2371 {
2372 prefix = subprefix_stack[--submenu_depth];
2373 i++;
2374 }
2375 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2376 {
2377 prefix
2378 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2379 i += MENU_ITEMS_PANE_LENGTH;
2380 }
2381 /* Ignore a nil in the item list.
2382 It's meaningful only for dialog boxes. */
2383 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2384 i += 1;
2385 else
2386 {
2387 entry
2388 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2389 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2390 {
2391 if (keymaps != 0)
2392 {
2393 int j;
2394
2395 entry = Fcons (entry, Qnil);
2396 if (!NILP (prefix))
2397 entry = Fcons (prefix, entry);
2398 for (j = submenu_depth - 1; j >= 0; j--)
2399 if (!NILP (subprefix_stack[j]))
2400 entry = Fcons (subprefix_stack[j], entry);
2401 }
2402 return entry;
2403 }
2404 i += MENU_ITEMS_ITEM_LENGTH;
2405 }
2406 }
2407 }
2408
2409 return Qnil;
2410 }
2411 \f
2412 static void
2413 dialog_selection_callback (widget, id, client_data)
2414 Widget widget;
2415 LWLIB_ID id;
2416 XtPointer client_data;
2417 {
2418 /* The EMACS_INT cast avoids a warning. There's no problem
2419 as long as pointers have enough bits to hold small integers. */
2420 if ((int) (EMACS_INT) client_data != -1)
2421 menu_item_selection = (Lisp_Object *) client_data;
2422 BLOCK_INPUT;
2423 lw_destroy_all_widgets (id);
2424 UNBLOCK_INPUT;
2425 popup_activated_flag = 0;
2426 }
2427
2428 /* ARG is the LWLIB ID of the dialog box, represented
2429 as a Lisp object as (HIGHPART . LOWPART). */
2430
2431 Lisp_Object
2432 xdialog_show_unwind (arg)
2433 Lisp_Object arg;
2434 {
2435 LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
2436 | XINT (XCDR (arg)));
2437 BLOCK_INPUT;
2438 lw_destroy_all_widgets (id);
2439 UNBLOCK_INPUT;
2440 popup_activated_flag = 0;
2441 return Qnil;
2442 }
2443
2444 static char * button_names [] = {
2445 "button1", "button2", "button3", "button4", "button5",
2446 "button6", "button7", "button8", "button9", "button10" };
2447
2448 static Lisp_Object
2449 xdialog_show (f, keymaps, title, error)
2450 FRAME_PTR f;
2451 int keymaps;
2452 Lisp_Object title;
2453 char **error;
2454 {
2455 int i, nb_buttons=0;
2456 LWLIB_ID dialog_id;
2457 char dialog_name[6];
2458
2459 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2460
2461 /* Number of elements seen so far, before boundary. */
2462 int left_count = 0;
2463 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2464 int boundary_seen = 0;
2465
2466 *error = NULL;
2467
2468 if (menu_items_n_panes > 1)
2469 {
2470 *error = "Multiple panes in dialog box";
2471 return Qnil;
2472 }
2473
2474 /* Create a tree of widget_value objects
2475 representing the text label and buttons. */
2476 {
2477 Lisp_Object pane_name, prefix;
2478 char *pane_string;
2479 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2480 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2481 pane_string = (NILP (pane_name)
2482 ? "" : (char *) SDATA (pane_name));
2483 prev_wv = xmalloc_widget_value ();
2484 prev_wv->value = pane_string;
2485 if (keymaps && !NILP (prefix))
2486 prev_wv->name++;
2487 prev_wv->enabled = 1;
2488 prev_wv->name = "message";
2489 prev_wv->help = Qnil;
2490 first_wv = prev_wv;
2491
2492 /* Loop over all panes and items, filling in the tree. */
2493 i = MENU_ITEMS_PANE_LENGTH;
2494 while (i < menu_items_used)
2495 {
2496
2497 /* Create a new item within current pane. */
2498 Lisp_Object item_name, enable, descrip;
2499 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2500 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2501 descrip
2502 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2503
2504 if (NILP (item_name))
2505 {
2506 free_menubar_widget_value_tree (first_wv);
2507 *error = "Submenu in dialog items";
2508 return Qnil;
2509 }
2510 if (EQ (item_name, Qquote))
2511 {
2512 /* This is the boundary between left-side elts
2513 and right-side elts. Stop incrementing right_count. */
2514 boundary_seen = 1;
2515 i++;
2516 continue;
2517 }
2518 if (nb_buttons >= 9)
2519 {
2520 free_menubar_widget_value_tree (first_wv);
2521 *error = "Too many dialog items";
2522 return Qnil;
2523 }
2524
2525 wv = xmalloc_widget_value ();
2526 prev_wv->next = wv;
2527 wv->name = (char *) button_names[nb_buttons];
2528 if (!NILP (descrip))
2529 wv->key = (char *) SDATA (descrip);
2530 wv->value = (char *) SDATA (item_name);
2531 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
2532 wv->enabled = !NILP (enable);
2533 wv->help = Qnil;
2534 prev_wv = wv;
2535
2536 if (! boundary_seen)
2537 left_count++;
2538
2539 nb_buttons++;
2540 i += MENU_ITEMS_ITEM_LENGTH;
2541 }
2542
2543 /* If the boundary was not specified,
2544 by default put half on the left and half on the right. */
2545 if (! boundary_seen)
2546 left_count = nb_buttons - nb_buttons / 2;
2547
2548 wv = xmalloc_widget_value ();
2549 wv->name = dialog_name;
2550 wv->help = Qnil;
2551 /* Dialog boxes use a really stupid name encoding
2552 which specifies how many buttons to use
2553 and how many buttons are on the right.
2554 The Q means something also. */
2555 dialog_name[0] = 'Q';
2556 dialog_name[1] = '0' + nb_buttons;
2557 dialog_name[2] = 'B';
2558 dialog_name[3] = 'R';
2559 /* Number of buttons to put on the right. */
2560 dialog_name[4] = '0' + nb_buttons - left_count;
2561 dialog_name[5] = 0;
2562 wv->contents = first_wv;
2563 first_wv = wv;
2564 }
2565
2566 /* Actually create the dialog. */
2567 dialog_id = widget_id_tick++;
2568 lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2569 f->output_data.x->widget, 1, 0,
2570 dialog_selection_callback, 0, 0);
2571 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2572 /* Free the widget_value objects we used to specify the contents. */
2573 free_menubar_widget_value_tree (first_wv);
2574
2575 /* No selection has been chosen yet. */
2576 menu_item_selection = 0;
2577
2578 /* Display the dialog box. */
2579 lw_pop_up_all_widgets (dialog_id);
2580 popup_activated_flag = 1;
2581
2582 /* Process events that apply to the dialog box.
2583 Also handle timers. */
2584 {
2585 int count = SPECPDL_INDEX ();
2586
2587 /* xdialog_show_unwind is responsible for popping the dialog box down. */
2588 record_unwind_protect (xdialog_show_unwind,
2589 Fcons (make_number (dialog_id >> (4 * sizeof (LWLIB_ID))),
2590 make_number (dialog_id & ~(-1 << (4 * sizeof (LWLIB_ID))))));
2591
2592 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id, 1);
2593
2594 unbind_to (count, Qnil);
2595 }
2596
2597 /* Find the selected item and pane, and return the corresponding value. */
2598 if (menu_item_selection != 0)
2599 {
2600 Lisp_Object prefix;
2601
2602 prefix = Qnil;
2603 i = 0;
2604 while (i < menu_items_used)
2605 {
2606 Lisp_Object entry;
2607
2608 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2609 {
2610 prefix
2611 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2612 i += MENU_ITEMS_PANE_LENGTH;
2613 }
2614 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2615 {
2616 /* This is the boundary between left-side elts and
2617 right-side elts. */
2618 ++i;
2619 }
2620 else
2621 {
2622 entry
2623 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2624 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2625 {
2626 if (keymaps != 0)
2627 {
2628 entry = Fcons (entry, Qnil);
2629 if (!NILP (prefix))
2630 entry = Fcons (prefix, entry);
2631 }
2632 return entry;
2633 }
2634 i += MENU_ITEMS_ITEM_LENGTH;
2635 }
2636 }
2637 }
2638
2639 return Qnil;
2640 }
2641
2642 #else /* not USE_X_TOOLKIT */
2643
2644 /* The frame of the last activated non-toolkit menu bar.
2645 Used to generate menu help events. */
2646
2647 static struct frame *menu_help_frame;
2648
2649
2650 /* Show help HELP_STRING, or clear help if HELP_STRING is null.
2651
2652 PANE is the pane number, and ITEM is the menu item number in
2653 the menu (currently not used).
2654
2655 This cannot be done with generating a HELP_EVENT because
2656 XMenuActivate contains a loop that doesn't let Emacs process
2657 keyboard events. */
2658
2659 static void
2660 menu_help_callback (help_string, pane, item)
2661 char *help_string;
2662 int pane, item;
2663 {
2664 extern Lisp_Object Qmenu_item;
2665 Lisp_Object *first_item;
2666 Lisp_Object pane_name;
2667 Lisp_Object menu_object;
2668
2669 first_item = XVECTOR (menu_items)->contents;
2670 if (EQ (first_item[0], Qt))
2671 pane_name = first_item[MENU_ITEMS_PANE_NAME];
2672 else if (EQ (first_item[0], Qquote))
2673 /* This shouldn't happen, see xmenu_show. */
2674 pane_name = empty_string;
2675 else
2676 pane_name = first_item[MENU_ITEMS_ITEM_NAME];
2677
2678 /* (menu-item MENU-NAME PANE-NUMBER) */
2679 menu_object = Fcons (Qmenu_item,
2680 Fcons (pane_name,
2681 Fcons (make_number (pane), Qnil)));
2682 show_help_echo (help_string ? build_string (help_string) : Qnil,
2683 Qnil, menu_object, make_number (item), 1);
2684 }
2685
2686
2687 static Lisp_Object
2688 xmenu_show (f, x, y, for_click, keymaps, title, error)
2689 FRAME_PTR f;
2690 int x, y;
2691 int for_click;
2692 int keymaps;
2693 Lisp_Object title;
2694 char **error;
2695 {
2696 Window root;
2697 XMenu *menu;
2698 int pane, selidx, lpane, status;
2699 Lisp_Object entry, pane_prefix;
2700 char *datap;
2701 int ulx, uly, width, height;
2702 int dispwidth, dispheight;
2703 int i, j;
2704 int maxwidth;
2705 int dummy_int;
2706 unsigned int dummy_uint;
2707
2708 *error = 0;
2709 if (menu_items_n_panes == 0)
2710 return Qnil;
2711
2712 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2713 {
2714 *error = "Empty menu";
2715 return Qnil;
2716 }
2717
2718 /* Figure out which root window F is on. */
2719 XGetGeometry (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &root,
2720 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
2721 &dummy_uint, &dummy_uint);
2722
2723 /* Make the menu on that window. */
2724 menu = XMenuCreate (FRAME_X_DISPLAY (f), root, "emacs");
2725 if (menu == NULL)
2726 {
2727 *error = "Can't create menu";
2728 return Qnil;
2729 }
2730
2731 #ifdef HAVE_X_WINDOWS
2732 /* Adjust coordinates to relative to the outer (window manager) window. */
2733 {
2734 Window child;
2735 int win_x = 0, win_y = 0;
2736
2737 /* Find the position of the outside upper-left corner of
2738 the inner window, with respect to the outer window. */
2739 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
2740 {
2741 BLOCK_INPUT;
2742 XTranslateCoordinates (FRAME_X_DISPLAY (f),
2743
2744 /* From-window, to-window. */
2745 f->output_data.x->window_desc,
2746 f->output_data.x->parent_desc,
2747
2748 /* From-position, to-position. */
2749 0, 0, &win_x, &win_y,
2750
2751 /* Child of window. */
2752 &child);
2753 UNBLOCK_INPUT;
2754 x += win_x;
2755 y += win_y;
2756 }
2757 }
2758 #endif /* HAVE_X_WINDOWS */
2759
2760 /* Adjust coordinates to be root-window-relative. */
2761 x += f->output_data.x->left_pos;
2762 y += f->output_data.x->top_pos;
2763
2764 /* Create all the necessary panes and their items. */
2765 i = 0;
2766 while (i < menu_items_used)
2767 {
2768 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2769 {
2770 /* Create a new pane. */
2771 Lisp_Object pane_name, prefix;
2772 char *pane_string;
2773
2774 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
2775 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2776 pane_string = (NILP (pane_name)
2777 ? "" : (char *) SDATA (pane_name));
2778 if (keymaps && !NILP (prefix))
2779 pane_string++;
2780
2781 lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE);
2782 if (lpane == XM_FAILURE)
2783 {
2784 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2785 *error = "Can't create pane";
2786 return Qnil;
2787 }
2788 i += MENU_ITEMS_PANE_LENGTH;
2789
2790 /* Find the width of the widest item in this pane. */
2791 maxwidth = 0;
2792 j = i;
2793 while (j < menu_items_used)
2794 {
2795 Lisp_Object item;
2796 item = XVECTOR (menu_items)->contents[j];
2797 if (EQ (item, Qt))
2798 break;
2799 if (NILP (item))
2800 {
2801 j++;
2802 continue;
2803 }
2804 width = SBYTES (item);
2805 if (width > maxwidth)
2806 maxwidth = width;
2807
2808 j += MENU_ITEMS_ITEM_LENGTH;
2809 }
2810 }
2811 /* Ignore a nil in the item list.
2812 It's meaningful only for dialog boxes. */
2813 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2814 i += 1;
2815 else
2816 {
2817 /* Create a new item within current pane. */
2818 Lisp_Object item_name, enable, descrip, help;
2819 unsigned char *item_data;
2820 char *help_string;
2821
2822 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2823 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2824 descrip
2825 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2826 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
2827 help_string = STRINGP (help) ? SDATA (help) : NULL;
2828
2829 if (!NILP (descrip))
2830 {
2831 int gap = maxwidth - SBYTES (item_name);
2832 #ifdef C_ALLOCA
2833 Lisp_Object spacer;
2834 spacer = Fmake_string (make_number (gap), make_number (' '));
2835 item_name = concat2 (item_name, spacer);
2836 item_name = concat2 (item_name, descrip);
2837 item_data = SDATA (item_name);
2838 #else
2839 /* if alloca is fast, use that to make the space,
2840 to reduce gc needs. */
2841 item_data
2842 = (unsigned char *) alloca (maxwidth
2843 + SBYTES (descrip) + 1);
2844 bcopy (SDATA (item_name), item_data,
2845 SBYTES (item_name));
2846 for (j = SCHARS (item_name); j < maxwidth; j++)
2847 item_data[j] = ' ';
2848 bcopy (SDATA (descrip), item_data + j,
2849 SBYTES (descrip));
2850 item_data[j + SBYTES (descrip)] = 0;
2851 #endif
2852 }
2853 else
2854 item_data = SDATA (item_name);
2855
2856 if (XMenuAddSelection (FRAME_X_DISPLAY (f),
2857 menu, lpane, 0, item_data,
2858 !NILP (enable), help_string)
2859 == XM_FAILURE)
2860 {
2861 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2862 *error = "Can't add selection to menu";
2863 return Qnil;
2864 }
2865 i += MENU_ITEMS_ITEM_LENGTH;
2866 }
2867 }
2868
2869 /* All set and ready to fly. */
2870 XMenuRecompute (FRAME_X_DISPLAY (f), menu);
2871 dispwidth = DisplayWidth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
2872 dispheight = DisplayHeight (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f));
2873 x = min (x, dispwidth);
2874 y = min (y, dispheight);
2875 x = max (x, 1);
2876 y = max (y, 1);
2877 XMenuLocate (FRAME_X_DISPLAY (f), menu, 0, 0, x, y,
2878 &ulx, &uly, &width, &height);
2879 if (ulx+width > dispwidth)
2880 {
2881 x -= (ulx + width) - dispwidth;
2882 ulx = dispwidth - width;
2883 }
2884 if (uly+height > dispheight)
2885 {
2886 y -= (uly + height) - dispheight;
2887 uly = dispheight - height;
2888 }
2889 if (ulx < 0) x -= ulx;
2890 if (uly < 0) y -= uly;
2891
2892 XMenuSetAEQ (menu, TRUE);
2893 XMenuSetFreeze (menu, TRUE);
2894 pane = selidx = 0;
2895
2896 /* Help display under X won't work because XMenuActivate contains
2897 a loop that doesn't give Emacs a chance to process it. */
2898 menu_help_frame = f;
2899 status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
2900 x, y, ButtonReleaseMask, &datap,
2901 menu_help_callback);
2902
2903
2904 #ifdef HAVE_X_WINDOWS
2905 /* Assume the mouse has moved out of the X window.
2906 If it has actually moved in, we will get an EnterNotify. */
2907 x_mouse_leave (FRAME_X_DISPLAY_INFO (f));
2908 #endif
2909
2910 switch (status)
2911 {
2912 case XM_SUCCESS:
2913 #ifdef XDEBUG
2914 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2915 #endif
2916
2917 /* Find the item number SELIDX in pane number PANE. */
2918 i = 0;
2919 while (i < menu_items_used)
2920 {
2921 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2922 {
2923 if (pane == 0)
2924 pane_prefix
2925 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2926 pane--;
2927 i += MENU_ITEMS_PANE_LENGTH;
2928 }
2929 else
2930 {
2931 if (pane == -1)
2932 {
2933 if (selidx == 0)
2934 {
2935 entry
2936 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2937 if (keymaps != 0)
2938 {
2939 entry = Fcons (entry, Qnil);
2940 if (!NILP (pane_prefix))
2941 entry = Fcons (pane_prefix, entry);
2942 }
2943 break;
2944 }
2945 selidx--;
2946 }
2947 i += MENU_ITEMS_ITEM_LENGTH;
2948 }
2949 }
2950 break;
2951
2952 case XM_FAILURE:
2953 *error = "Can't activate menu";
2954 case XM_IA_SELECT:
2955 case XM_NO_SELECT:
2956 entry = Qnil;
2957 break;
2958 }
2959 XMenuDestroy (FRAME_X_DISPLAY (f), menu);
2960
2961 #ifdef HAVE_X_WINDOWS
2962 /* State that no mouse buttons are now held.
2963 (The oldXMenu code doesn't track this info for us.)
2964 That is not necessarily true, but the fiction leads to reasonable
2965 results, and it is a pain to ask which are actually held now. */
2966 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
2967 #endif
2968
2969 return entry;
2970 }
2971
2972 #endif /* not USE_X_TOOLKIT */
2973
2974 #endif /* HAVE_MENUS */
2975 \f
2976 void
2977 syms_of_xmenu ()
2978 {
2979 staticpro (&menu_items);
2980 menu_items = Qnil;
2981 menu_items_inuse = Qnil;
2982
2983 Qdebug_on_next_call = intern ("debug-on-next-call");
2984 staticpro (&Qdebug_on_next_call);
2985
2986 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2987 doc: /* Frame for which we are updating a menu.
2988 The enable predicate for a menu command should check this variable. */);
2989 Vmenu_updating_frame = Qnil;
2990
2991 #ifdef USE_X_TOOLKIT
2992 widget_id_tick = (1<<16);
2993 next_menubar_widget_id = 1;
2994 #endif
2995
2996 defsubr (&Sx_popup_menu);
2997 #ifdef HAVE_MENUS
2998 defsubr (&Sx_popup_dialog);
2999 #endif
3000 }