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