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