Fix references to diary.el.
[bpt/emacs.git] / src / xmenu.c
... / ...
CommitLineData
1/* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20/* X pop-up deck-of-cards menu facility for gnuemacs.
21 *
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
24 *
25 */
26
27/* Modified by Fred Pierresteguy on December 93
28 to make the popup menus and menubar use the Xt. */
29
30/* Rewritten for clarity and GC protection by rms in Feb 94. */
31
32/* On 4.3 this loses if it comes after xterm.h. */
33#include <signal.h>
34#include <config.h>
35
36#include <stdio.h>
37#include "lisp.h"
38#include "termhooks.h"
39#include "frame.h"
40#include "window.h"
41#include "keyboard.h"
42#include "blockinput.h"
43
44/* This may include sys/types.h, and that somehow loses
45 if this is not done before the other system files. */
46#include "xterm.h"
47
48/* Load sys/types.h if not already loaded.
49 In some systems loading it twice is suicidal. */
50#ifndef makedev
51#include <sys/types.h>
52#endif
53
54#include "dispextern.h"
55
56#ifdef HAVE_X11
57#include "../oldXMenu/XMenu.h"
58#else
59#include <X/XMenu.h>
60#endif
61
62#ifdef USE_X_TOOLKIT
63#include <X11/Xlib.h>
64#include <X11/IntrinsicP.h>
65#include <X11/CoreP.h>
66#include <X11/StringDefs.h>
67#include <X11/Xaw/Paned.h>
68#include "../lwlib/lwlib.h"
69#include "../lwlib/xlwmenuP.h"
70#endif /* USE_X_TOOLKIT */
71
72#define min(x,y) (((x) < (y)) ? (x) : (y))
73#define max(x,y) (((x) > (y)) ? (x) : (y))
74
75#ifndef TRUE
76#define TRUE 1
77#define FALSE 0
78#endif /* no TRUE */
79
80#ifdef HAVE_X11
81extern Display *x_current_display;
82#else
83#define ButtonReleaseMask ButtonReleased
84#endif /* not HAVE_X11 */
85
86/* We need a unique id for each popup menu and dialog box. */
87static unsigned int popup_id_tick;
88
89extern Lisp_Object Qmenu_enable;
90extern Lisp_Object Qmenu_bar;
91
92#ifdef USE_X_TOOLKIT
93extern void process_expose_from_menu ();
94extern XtAppContext Xt_app_con;
95
96static Lisp_Object xdialog_show ();
97#endif
98
99static Lisp_Object xmenu_show ();
100static void keymap_panes ();
101static void single_keymap_panes ();
102static void list_of_panes ();
103static void list_of_items ();
104\f
105/* This holds a Lisp vector that holds the results of decoding
106 the keymaps or alist-of-alists that specify a menu.
107
108 It describes the panes and items within the panes.
109
110 Each pane is described by 3 elements in the vector:
111 t, the pane name, the pane's prefix key.
112 Then follow the pane's items, with 4 elements per item:
113 the item string, the enable flag, the item's value,
114 and the equivalent keyboard key's description string.
115
116 In some cases, multiple levels of menus may be described.
117 A single vector slot containing nil indicates the start of a submenu.
118 A single vector slot containing lambda indicates the end of a submenu.
119 The submenu follows a menu item which is the way to reach the submenu.
120
121 A single vector slot containing quote indicates that the
122 following items should appear on the right of a dialog box.
123
124 Using a Lisp vector to hold this information while we decode it
125 takes care of protecting all the data from GC. */
126
127#define MENU_ITEMS_PANE_NAME 1
128#define MENU_ITEMS_PANE_PREFIX 2
129#define MENU_ITEMS_PANE_LENGTH 3
130
131#define MENU_ITEMS_ITEM_NAME 0
132#define MENU_ITEMS_ITEM_ENABLE 1
133#define MENU_ITEMS_ITEM_VALUE 2
134#define MENU_ITEMS_ITEM_EQUIV_KEY 3
135#define MENU_ITEMS_ITEM_LENGTH 4
136
137static Lisp_Object menu_items;
138
139/* Number of slots currently allocated in menu_items. */
140static int menu_items_allocated;
141
142/* This is the index in menu_items of the first empty slot. */
143static int menu_items_used;
144
145/* The number of panes currently recorded in menu_items,
146 excluding those within submenus. */
147static int menu_items_n_panes;
148
149/* Current depth within submenus. */
150static int menu_items_submenu_depth;
151
152/* Initialize the menu_items structure if we haven't already done so.
153 Also mark it as currently empty. */
154
155static void
156init_menu_items ()
157{
158 if (NILP (menu_items))
159 {
160 menu_items_allocated = 60;
161 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
162 }
163
164 menu_items_used = 0;
165 menu_items_n_panes = 0;
166 menu_items_submenu_depth = 0;
167}
168
169/* Call at the end of generating the data in menu_items.
170 This fills in the number of items in the last pane. */
171
172static void
173finish_menu_items ()
174{
175}
176
177/* Call when finished using the data for the current menu
178 in menu_items. */
179
180static void
181discard_menu_items ()
182{
183 /* Free the structure if it is especially large.
184 Otherwise, hold on to it, to save time. */
185 if (menu_items_allocated > 200)
186 {
187 menu_items = Qnil;
188 menu_items_allocated = 0;
189 }
190}
191
192/* Make the menu_items vector twice as large. */
193
194static void
195grow_menu_items ()
196{
197 Lisp_Object old;
198 int old_size = menu_items_allocated;
199 old = menu_items;
200
201 menu_items_allocated *= 2;
202 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
203 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
204 old_size * sizeof (Lisp_Object));
205}
206
207/* Begin a submenu. */
208
209static void
210push_submenu_start ()
211{
212 if (menu_items_used + 1 > menu_items_allocated)
213 grow_menu_items ();
214
215 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
216 menu_items_submenu_depth++;
217}
218
219/* End a submenu. */
220
221static void
222push_submenu_end ()
223{
224 if (menu_items_used + 1 > menu_items_allocated)
225 grow_menu_items ();
226
227 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
228 menu_items_submenu_depth--;
229}
230
231/* Indicate boundary between left and right. */
232
233static void
234push_left_right_boundary ()
235{
236 if (menu_items_used + 1 > menu_items_allocated)
237 grow_menu_items ();
238
239 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
240}
241
242/* Start a new menu pane in menu_items..
243 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
244
245static void
246push_menu_pane (name, prefix_vec)
247 Lisp_Object name, prefix_vec;
248{
249 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
250 grow_menu_items ();
251
252 if (menu_items_submenu_depth == 0)
253 menu_items_n_panes++;
254 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
255 XVECTOR (menu_items)->contents[menu_items_used++] = name;
256 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
257}
258
259/* Push one menu item into the current pane.
260 NAME is the string to display. ENABLE if non-nil means
261 this item can be selected. KEY is the key generated by
262 choosing this item. EQUIV is the textual description
263 of the keyboard equivalent for this item (or nil if none). */
264
265static void
266push_menu_item (name, enable, key, equiv)
267 Lisp_Object name, enable, key, equiv;
268{
269 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
270 grow_menu_items ();
271
272 XVECTOR (menu_items)->contents[menu_items_used++] = name;
273 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
274 XVECTOR (menu_items)->contents[menu_items_used++] = key;
275 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
276}
277\f
278/* Figure out the current keyboard equivalent of a menu item ITEM1.
279 The item string for menu display should be ITEM_STRING.
280 Store the equivalent keyboard key sequence's
281 textual description into *DESCRIP_PTR.
282 Also cache them in the item itself.
283 Return the real definition to execute. */
284
285static Lisp_Object
286menu_item_equiv_key (item_string, item1, descrip_ptr)
287 Lisp_Object item_string;
288 Lisp_Object item1;
289 Lisp_Object *descrip_ptr;
290{
291 /* This is the real definition--the function to run. */
292 Lisp_Object def;
293 /* This is the sublist that records cached equiv key data
294 so we can save time. */
295 Lisp_Object cachelist;
296 /* These are the saved equivalent keyboard key sequence
297 and its key-description. */
298 Lisp_Object savedkey, descrip;
299 Lisp_Object def1;
300 int changed = 0;
301
302 /* If a help string follows the item string, skip it. */
303 if (CONSP (XCONS (item1)->cdr)
304 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
305 item1 = XCONS (item1)->cdr;
306
307 def = Fcdr (item1);
308
309 /* Get out the saved equivalent-keyboard-key info. */
310 cachelist = savedkey = descrip = Qnil;
311 if (CONSP (def) && CONSP (XCONS (def)->car)
312 && (NILP (XCONS (XCONS (def)->car)->car)
313 || VECTORP (XCONS (XCONS (def)->car)->car)))
314 {
315 cachelist = XCONS (def)->car;
316 def = XCONS (def)->cdr;
317 savedkey = XCONS (cachelist)->car;
318 descrip = XCONS (cachelist)->cdr;
319 }
320
321 /* Is it still valid? */
322 def1 = Qnil;
323 if (!NILP (savedkey))
324 def1 = Fkey_binding (savedkey, Qnil);
325 /* If not, update it. */
326 if (! EQ (def1, def)
327 /* If the command is an alias for another
328 (such as easymenu.el and lmenu.el set it up),
329 check if the original command matches the cached command. */
330 && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
331 && EQ (def1, XSYMBOL (def)->function))
332 /* If something had no key binding before, don't recheck it--
333 doing that takes too much time and makes menus too slow. */
334 && !(!NILP (cachelist) && NILP (savedkey)))
335 {
336 changed = 1;
337 descrip = Qnil;
338 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
339 /* If the command is an alias for another
340 (such as easymenu.el and lmenu.el set it up),
341 see if the original command name has equivalent keys. */
342 if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
343 savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
344 Qnil, Qt, Qnil);
345
346 if (VECTORP (savedkey)
347 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
348 savedkey = Qnil;
349 if (!NILP (savedkey))
350 {
351 descrip = Fkey_description (savedkey);
352 descrip = concat2 (make_string (" (", 3), descrip);
353 descrip = concat2 (descrip, make_string (")", 1));
354 }
355 }
356
357 /* Cache the data we just got in a sublist of the menu binding. */
358 if (NILP (cachelist))
359 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
360 else if (changed)
361 {
362 XCONS (cachelist)->car = savedkey;
363 XCONS (cachelist)->cdr = descrip;
364 }
365
366 *descrip_ptr = descrip;
367 return def;
368}
369
370/* This is used as the handler when calling internal_condition_case_1. */
371
372static Lisp_Object
373menu_item_enabled_p_1 (arg)
374 Lisp_Object arg;
375{
376 return Qnil;
377}
378
379/* Return non-nil if the command DEF is enabled when used as a menu item.
380 This is based on looking for a menu-enable property.
381 If NOTREAL is set, don't bother really computing this. */
382
383static Lisp_Object
384menu_item_enabled_p (def, notreal)
385 Lisp_Object def;
386{
387 Lisp_Object enabled, tem;
388
389 enabled = Qt;
390 if (notreal)
391 return enabled;
392 if (XTYPE (def) == Lisp_Symbol)
393 {
394 /* No property, or nil, means enable.
395 Otherwise, enable if value is not nil. */
396 tem = Fget (def, Qmenu_enable);
397 if (!NILP (tem))
398 /* (condition-case nil (eval tem)
399 (error nil)) */
400 enabled = internal_condition_case_1 (Feval, tem, Qerror,
401 menu_item_enabled_p_1);
402 }
403 return enabled;
404}
405\f
406/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
407 and generate menu panes for them in menu_items.
408 If NOTREAL is nonzero,
409 don't bother really computing whether an item is enabled. */
410
411static void
412keymap_panes (keymaps, nmaps, notreal)
413 Lisp_Object *keymaps;
414 int nmaps;
415 int notreal;
416{
417 int mapno;
418
419 init_menu_items ();
420
421 /* Loop over the given keymaps, making a pane for each map.
422 But don't make a pane that is empty--ignore that map instead.
423 P is the number of panes we have made so far. */
424 for (mapno = 0; mapno < nmaps; mapno++)
425 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal);
426
427 finish_menu_items ();
428}
429
430/* This is a recursive subroutine of keymap_panes.
431 It handles one keymap, KEYMAP.
432 The other arguments are passed along
433 or point to local variables of the previous function.
434 If NOTREAL is nonzero,
435 don't bother really computing whether an item is enabled. */
436
437static void
438single_keymap_panes (keymap, pane_name, prefix, notreal)
439 Lisp_Object keymap;
440 Lisp_Object pane_name;
441 Lisp_Object prefix;
442 int notreal;
443{
444 Lisp_Object pending_maps;
445 Lisp_Object tail, item, item1, item_string, table;
446 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
447
448 pending_maps = Qnil;
449
450 push_menu_pane (pane_name, prefix);
451
452 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
453 {
454 /* Look at each key binding, and if it has a menu string,
455 make a menu item from it. */
456 item = XCONS (tail)->car;
457 if (XTYPE (item) == Lisp_Cons)
458 {
459 item1 = XCONS (item)->cdr;
460 if (XTYPE (item1) == Lisp_Cons)
461 {
462 item_string = XCONS (item1)->car;
463 if (XTYPE (item_string) == Lisp_String)
464 {
465 /* This is the real definition--the function to run. */
466 Lisp_Object def;
467 /* These are the saved equivalent keyboard key sequence
468 and its key-description. */
469 Lisp_Object descrip;
470 Lisp_Object tem, enabled;
471
472 def = menu_item_equiv_key (item_string, item1, &descrip);
473
474 /* GCPRO because we will call eval.
475 Protecting KEYMAP preserves everything we use;
476 aside from that, must protect whatever might be
477 a string. Since there's no GCPRO5, we refetch
478 item_string instead of protecting it. */
479 GCPRO4 (keymap, pending_maps, def, descrip);
480 enabled = menu_item_enabled_p (def, notreal);
481
482 UNGCPRO;
483
484 item_string = XCONS (item1)->car;
485
486 tem = Fkeymapp (def);
487 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
488 pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)),
489 pending_maps);
490 else
491 {
492 Lisp_Object submap;
493 GCPRO4 (keymap, pending_maps, descrip, item_string);
494 submap = get_keymap_1 (def, 0, 1);
495 UNGCPRO;
496#ifndef USE_X_TOOLKIT
497 /* Indicate visually that this is a submenu. */
498 if (!NILP (submap))
499 item_string = concat2 (item_string,
500 build_string (" >"));
501#endif
502 push_menu_item (item_string, enabled, XCONS (item)->car,
503 descrip);
504#ifdef USE_X_TOOLKIT
505 /* Display a submenu using the toolkit. */
506 if (! NILP (submap))
507 {
508 push_submenu_start ();
509 single_keymap_panes (submap, Qnil,
510 XCONS (item)->car, notreal);
511 push_submenu_end ();
512 }
513#endif
514 }
515 }
516 }
517 }
518 else if (XTYPE (item) == Lisp_Vector)
519 {
520 /* Loop over the char values represented in the vector. */
521 int len = XVECTOR (item)->size;
522 int c;
523 for (c = 0; c < len; c++)
524 {
525 Lisp_Object character;
526 XFASTINT (character) = c;
527 item1 = XVECTOR (item)->contents[c];
528 if (XTYPE (item1) == Lisp_Cons)
529 {
530 item_string = XCONS (item1)->car;
531 if (XTYPE (item_string) == Lisp_String)
532 {
533 Lisp_Object def;
534
535 /* These are the saved equivalent keyboard key sequence
536 and its key-description. */
537 Lisp_Object descrip;
538 Lisp_Object tem, enabled;
539
540 def = menu_item_equiv_key (item_string, item1, &descrip);
541
542 /* GCPRO because we will call eval.
543 Protecting KEYMAP preserves everything we use;
544 aside from that, must protect whatever might be
545 a string. Since there's no GCPRO5, we refetch
546 item_string instead of protecting it. */
547 GCPRO4 (keymap, pending_maps, def, descrip);
548 enabled = menu_item_enabled_p (def, notreal);
549 UNGCPRO;
550
551 item_string = XCONS (item1)->car;
552
553 tem = Fkeymapp (def);
554 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
555 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
556 pending_maps);
557 else
558 {
559 Lisp_Object submap;
560 GCPRO4 (keymap, pending_maps, descrip, item_string);
561 submap = get_keymap_1 (def, 0, 1);
562 UNGCPRO;
563#ifndef USE_X_TOOLKIT
564 if (!NILP (submap))
565 item_string = concat2 (item_string,
566 build_string (" >"));
567#endif
568 push_menu_item (item_string, enabled, character,
569 descrip);
570#ifdef USE_X_TOOLKIT
571 if (! NILP (submap))
572 {
573 push_submenu_start ();
574 single_keymap_panes (submap, Qnil,
575 character, notreal);
576 push_submenu_end ();
577 }
578#endif
579 }
580 }
581 }
582 }
583 }
584 }
585
586 /* Process now any submenus which want to be panes at this level. */
587 while (!NILP (pending_maps))
588 {
589 Lisp_Object elt, eltcdr, string;
590 elt = Fcar (pending_maps);
591 eltcdr = XCONS (elt)->cdr;
592 string = XCONS (eltcdr)->car;
593 /* We no longer discard the @ from the beginning of the string here.
594 Instead, we do this in xmenu_show. */
595 single_keymap_panes (Fcar (elt), string,
596 XCONS (eltcdr)->cdr, notreal);
597 pending_maps = Fcdr (pending_maps);
598 }
599}
600\f
601/* Push all the panes and items of a menu decsribed by the
602 alist-of-alists MENU.
603 This handles old-fashioned calls to x-popup-menu. */
604
605static void
606list_of_panes (menu)
607 Lisp_Object menu;
608{
609 Lisp_Object tail;
610
611 init_menu_items ();
612
613 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
614 {
615 Lisp_Object elt, pane_name, pane_data;
616 elt = Fcar (tail);
617 pane_name = Fcar (elt);
618 CHECK_STRING (pane_name, 0);
619 push_menu_pane (pane_name, Qnil);
620 pane_data = Fcdr (elt);
621 CHECK_CONS (pane_data, 0);
622 list_of_items (pane_data);
623 }
624
625 finish_menu_items ();
626}
627
628/* Push the items in a single pane defined by the alist PANE. */
629
630static void
631list_of_items (pane)
632 Lisp_Object pane;
633{
634 Lisp_Object tail, item, item1;
635
636 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
637 {
638 item = Fcar (tail);
639 if (STRINGP (item))
640 push_menu_item (item, Qnil, Qnil, Qnil);
641 else if (NILP (item))
642 push_left_right_boundary ();
643 else
644 {
645 CHECK_CONS (item, 0);
646 item1 = Fcar (item);
647 CHECK_STRING (item1, 1);
648 push_menu_item (item1, Qt, Fcdr (item), Qnil);
649 }
650 }
651}
652\f
653DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
654 "Pop up a deck-of-cards menu and return user's selection.\n\
655POSITION is a position specification. This is either a mouse button event\n\
656or a list ((XOFFSET YOFFSET) WINDOW)\n\
657where XOFFSET and YOFFSET are positions in pixels from the top left\n\
658corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
659This controls the position of the center of the first line\n\
660in the first pane of the menu, not the top left of the menu as a whole.\n\
661If POSITION is t, it means to use the current mouse position.\n\
662\n\
663MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
664The menu items come from key bindings that have a menu string as well as\n\
665a definition; actually, the \"definition\" in such a key binding looks like\n\
666\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
667the keymap as a top-level element.\n\n\
668You can also use a list of keymaps as MENU.\n\
669 Then each keymap makes a separate pane.\n\
670When MENU is a keymap or a list of keymaps, the return value\n\
671is a list of events.\n\n\
672Alternatively, you can specify a menu of multiple panes\n\
673 with a list of the form (TITLE PANE1 PANE2...),\n\
674where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
675Each ITEM is normally a cons cell (STRING . VALUE);\n\
676but a string can appear as an item--that makes a nonselectable line\n\
677in the menu.\n\
678With this form of menu, the return value is VALUE from the chosen item.\n\
679\n\
680If POSITION is nil, don't display the menu at all, just precalculate the\n\
681cached information about equivalent key sequences.")
682 (position, menu)
683 Lisp_Object position, menu;
684{
685 int number_of_panes, panes;
686 Lisp_Object keymap, tem;
687 int xpos, ypos;
688 Lisp_Object title;
689 char *error_name;
690 Lisp_Object selection;
691 int i, j;
692 FRAME_PTR f;
693 Lisp_Object x, y, window;
694 int keymaps = 0;
695 int menubarp = 0;
696 struct gcpro gcpro1;
697
698 if (! NILP (position))
699 {
700 check_x ();
701
702 /* Decode the first argument: find the window and the coordinates. */
703 if (EQ (position, Qt))
704 {
705 /* Use the mouse's current position. */
706 FRAME_PTR new_f = 0;
707 Lisp_Object bar_window;
708 int part;
709 unsigned long time;
710
711 if (mouse_position_hook)
712 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
713 if (new_f != 0)
714 XSET (window, Lisp_Frame, new_f);
715 else
716 {
717 window = selected_window;
718 XFASTINT (x) = 0;
719 XFASTINT (y) = 0;
720 }
721 }
722 else
723 {
724 tem = Fcar (position);
725 if (XTYPE (tem) == Lisp_Cons)
726 {
727 window = Fcar (Fcdr (position));
728 x = Fcar (tem);
729 y = Fcar (Fcdr (tem));
730 }
731 else
732 {
733 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
734 window = Fcar (tem); /* POSN_WINDOW (tem) */
735 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
736 x = Fcar (tem);
737 y = Fcdr (tem);
738
739 /* Determine whether this menu is handling a menu bar click. */
740 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
741 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
742 menubarp = 1;
743 }
744 }
745
746 CHECK_NUMBER (x, 0);
747 CHECK_NUMBER (y, 0);
748
749 /* Decode where to put the menu. */
750
751 if (XTYPE (window) == Lisp_Frame)
752 {
753 f = XFRAME (window);
754
755 xpos = 0;
756 ypos = 0;
757 }
758 else if (XTYPE (window) == Lisp_Window)
759 {
760 CHECK_LIVE_WINDOW (window, 0);
761 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
762
763 xpos = (FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left);
764 ypos = (f->display.x->line_height * XWINDOW (window)->top);
765 }
766 else
767 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
768 but I don't want to make one now. */
769 CHECK_WINDOW (window, 0);
770
771 xpos += XINT (x);
772 ypos += XINT (y);
773 }
774
775 title = Qnil;
776 GCPRO1 (title);
777
778 /* Decode the menu items from what was specified. */
779
780 keymap = Fkeymapp (menu);
781 tem = Qnil;
782 if (XTYPE (menu) == Lisp_Cons)
783 tem = Fkeymapp (Fcar (menu));
784 if (!NILP (keymap))
785 {
786 /* We were given a keymap. Extract menu info from the keymap. */
787 Lisp_Object prompt;
788 keymap = get_keymap (menu);
789
790 /* Extract the detailed info to make one pane. */
791 keymap_panes (&menu, 1, NILP (position));
792
793 /* Search for a string appearing directly as an element of the keymap.
794 That string is the title of the menu. */
795 prompt = map_prompt (keymap);
796
797 /* Make that be the pane title of the first pane. */
798 if (!NILP (prompt) && menu_items_n_panes >= 0)
799 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
800
801 keymaps = 1;
802 }
803 else if (!NILP (tem))
804 {
805 /* We were given a list of keymaps. */
806 int nmaps = XFASTINT (Flength (menu));
807 Lisp_Object *maps
808 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
809 int i;
810
811 title = Qnil;
812
813 /* The first keymap that has a prompt string
814 supplies the menu title. */
815 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
816 {
817 Lisp_Object prompt;
818
819 maps[i++] = keymap = get_keymap (Fcar (tem));
820
821 prompt = map_prompt (keymap);
822 if (NILP (title) && !NILP (prompt))
823 title = prompt;
824 }
825
826 /* Extract the detailed info to make one pane. */
827 keymap_panes (maps, nmaps, NILP (position));
828
829 /* Make the title be the pane title of the first pane. */
830 if (!NILP (title) && menu_items_n_panes >= 0)
831 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
832
833 keymaps = 1;
834 }
835 else
836 {
837 /* We were given an old-fashioned menu. */
838 title = Fcar (menu);
839 CHECK_STRING (title, 1);
840
841 list_of_panes (Fcdr (menu));
842
843 keymaps = 0;
844 }
845
846 if (NILP (position))
847 {
848 discard_menu_items ();
849 UNGCPRO;
850 return Qnil;
851 }
852
853 /* Display them in a menu. */
854 BLOCK_INPUT;
855
856 selection = xmenu_show (f, xpos, ypos, menubarp,
857 keymaps, title, &error_name);
858 UNBLOCK_INPUT;
859
860 discard_menu_items ();
861
862 UNGCPRO;
863
864 if (error_name) error (error_name);
865 return selection;
866}
867
868DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
869 "Pop up a dialog box and return user's selection.\n\
870POSITION specifies which frame to use.\n\
871This is normally a mouse button event or a window or frame.\n\
872If POSITION is t, it means to use the frame the mouse is on.\n\
873The dialog box appears in the middle of the specified frame.\n\
874\n\
875CONTENTS specifies the alternatives to display in the dialog box.\n\
876It is a list of the form (TITLE ITEM1 ITEM2...).\n\
877Each ITEM is a cons cell (STRING . VALUE).\n\
878The return value is VALUE from the chosen item.\n\n\
879An ITEM may also be just a string--that makes a nonselectable item.\n\
880An ITEM may also be nil--that means to put all preceding items\n\
881on the left of the dialog box and all following items on the right.\n\
882\(By default, approximately half appear on each side.)")
883 (position, contents)
884 Lisp_Object position, contents;
885{
886 FRAME_PTR f;
887 Lisp_Object window;
888
889 check_x ();
890
891 /* Decode the first argument: find the window or frame to use. */
892 if (EQ (position, Qt))
893 {
894#if 0 /* Using the frame the mouse is on may not be right. */
895 /* Use the mouse's current position. */
896 FRAME_PTR new_f = 0;
897 Lisp_Object bar_window;
898 int part;
899 unsigned long time;
900 Lisp_Object x, y;
901
902 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
903
904 if (new_f != 0)
905 XSET (window, Lisp_Frame, new_f);
906 else
907 window = selected_window;
908#endif
909 /* Decode the first argument: find the window and the coordinates. */
910 if (EQ (position, Qt))
911 window = selected_window;
912 }
913 else if (CONSP (position))
914 {
915 Lisp_Object tem;
916 tem = Fcar (position);
917 if (XTYPE (tem) == Lisp_Cons)
918 window = Fcar (Fcdr (position));
919 else
920 {
921 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
922 window = Fcar (tem); /* POSN_WINDOW (tem) */
923 }
924 }
925 else if (WINDOWP (position) || FRAMEP (position))
926 window = position;
927
928 /* Decode where to put the menu. */
929
930 if (XTYPE (window) == Lisp_Frame)
931 f = XFRAME (window);
932 else if (XTYPE (window) == Lisp_Window)
933 {
934 CHECK_LIVE_WINDOW (window, 0);
935 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
936 }
937 else
938 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
939 but I don't want to make one now. */
940 CHECK_WINDOW (window, 0);
941
942#ifndef USE_X_TOOLKIT
943 /* Display a menu with these alternatives
944 in the middle of frame F. */
945 {
946 Lisp_Object x, y, frame, newpos;
947 XSET (frame, Lisp_Frame, f);
948 XSET (x, Lisp_Int, x_pixel_width (f) / 2);
949 XSET (y, Lisp_Int, x_pixel_height (f) / 2);
950 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
951
952 return Fx_popup_menu (newpos,
953 Fcons (Fcar (contents), Fcons (contents, Qnil)));
954 }
955#else
956 {
957 Lisp_Object title;
958 char *error_name;
959 Lisp_Object selection;
960
961 /* Decode the dialog items from what was specified. */
962 title = Fcar (contents);
963 CHECK_STRING (title, 1);
964
965 list_of_panes (Fcons (contents, Qnil));
966
967 /* Display them in a dialog box. */
968 BLOCK_INPUT;
969 selection = xdialog_show (f, 0, 0, title, &error_name);
970 UNBLOCK_INPUT;
971
972 discard_menu_items ();
973
974 if (error_name) error (error_name);
975 return selection;
976 }
977#endif
978}
979\f
980#ifdef USE_X_TOOLKIT
981
982static void
983dispatch_dummy_expose (w, x, y)
984 Widget w;
985 int x;
986 int y;
987{
988 XExposeEvent dummy;
989
990 dummy.type = Expose;
991 dummy.window = XtWindow (w);
992 dummy.count = 0;
993 dummy.serial = 0;
994 dummy.send_event = 0;
995 dummy.display = XtDisplay (w);
996 dummy.x = x;
997 dummy.y = y;
998
999 XtDispatchEvent ((XEvent *) &dummy);
1000}
1001
1002static int
1003event_is_in_menu_item (mw, event, name, string_w)
1004 XlwMenuWidget mw;
1005 struct input_event *event;
1006 char *name;
1007 int *string_w;
1008{
1009 *string_w += (string_width (mw, name)
1010 + 2 * (mw->menu.horizontal_spacing
1011 + mw->menu.shadow_thickness));
1012 return XINT (event->x) < *string_w;
1013}
1014
1015
1016/* Return the menu bar key which corresponds to event EVENT in frame F. */
1017
1018Lisp_Object
1019map_event_to_object (event, f)
1020 struct input_event *event;
1021 FRAME_PTR f;
1022{
1023 int i,j, string_w;
1024 window_state* ws;
1025 XlwMenuWidget mw = (XlwMenuWidget) f->display.x->menubar_widget;
1026 widget_value *val;
1027
1028
1029 string_w = 0;
1030 /* Find the window */
1031 for (val = mw->menu.old_stack [0]->contents; val; val = val->next)
1032 {
1033 ws = &mw->menu.windows [0];
1034 if (ws && event_is_in_menu_item (mw, event, val->name, &string_w))
1035 {
1036 Lisp_Object items;
1037 int i;
1038
1039 items = FRAME_MENU_BAR_ITEMS (f);
1040
1041 for (i = 0; i < XVECTOR (items)->size; i += 3)
1042 {
1043 Lisp_Object pos, string, item;
1044 item = XVECTOR (items)->contents[i];
1045 string = XVECTOR (items)->contents[i + 1];
1046 pos = XVECTOR (items)->contents[i + 2];
1047 if (NILP (string))
1048 break;
1049
1050 if (!strcmp (val->name, XSTRING (string)->data))
1051 return item;
1052 }
1053 }
1054 }
1055 return Qnil;
1056}
1057
1058static Lisp_Object *menu_item_selection;
1059
1060static void
1061popup_selection_callback (widget, id, client_data)
1062 Widget widget;
1063 LWLIB_ID id;
1064 XtPointer client_data;
1065{
1066 menu_item_selection = (Lisp_Object *) client_data;
1067}
1068
1069static void
1070popup_down_callback (widget, id, client_data)
1071 Widget widget;
1072 LWLIB_ID id;
1073 XtPointer client_data;
1074{
1075 BLOCK_INPUT;
1076 lw_destroy_all_widgets (id);
1077 UNBLOCK_INPUT;
1078}
1079
1080static void
1081dialog_selection_callback (widget, id, client_data)
1082 Widget widget;
1083 LWLIB_ID id;
1084 XtPointer client_data;
1085{
1086 if ((int)client_data != -1)
1087 menu_item_selection = (Lisp_Object *) client_data;
1088 BLOCK_INPUT;
1089 lw_destroy_all_widgets (id);
1090 UNBLOCK_INPUT;
1091}
1092
1093/* This recursively calls free_widget_value() on the tree of widgets.
1094 It must free all data that was malloc'ed for these widget_values.
1095 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1096 must be left alone. */
1097
1098void
1099free_menubar_widget_value_tree (wv)
1100 widget_value *wv;
1101{
1102 if (! wv) return;
1103
1104 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1105
1106 if (wv->contents && (wv->contents != (widget_value*)1))
1107 {
1108 free_menubar_widget_value_tree (wv->contents);
1109 wv->contents = (widget_value *) 0xDEADBEEF;
1110 }
1111 if (wv->next)
1112 {
1113 free_menubar_widget_value_tree (wv->next);
1114 wv->next = (widget_value *) 0xDEADBEEF;
1115 }
1116 BLOCK_INPUT;
1117 free_widget_value (wv);
1118 UNBLOCK_INPUT;
1119}
1120
1121extern void EmacsFrameSetCharSize ();
1122
1123static void
1124update_frame_menubar (f)
1125 FRAME_PTR f;
1126{
1127 struct x_display *x = f->display.x;
1128 int columns, rows;
1129 int menubar_changed;
1130
1131 menubar_changed = (x->menubar_widget
1132 && !XtIsManaged (x->menubar_widget));
1133
1134 if (! (menubar_changed))
1135 return;
1136
1137 BLOCK_INPUT;
1138 /* Save the size of the frame because the pane widget doesn't accept to
1139 resize itself. So force it. */
1140 columns = f->width;
1141 rows = f->height;
1142
1143
1144 XawPanedSetRefigureMode (x->column_widget, 0);
1145
1146 /* the order in which children are managed is the top to
1147 bottom order in which they are displayed in the paned window.
1148 First, remove the text-area widget.
1149 */
1150 XtUnmanageChild (x->edit_widget);
1151
1152 /* remove the menubar that is there now, and put up the menubar that
1153 should be there.
1154 */
1155 if (menubar_changed)
1156 {
1157 XtManageChild (x->menubar_widget);
1158 XtMapWidget (x->menubar_widget);
1159 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
1160 }
1161
1162
1163 /* Re-manage the text-area widget */
1164 XtManageChild (x->edit_widget);
1165
1166 /* and now thrash the sizes */
1167 XawPanedSetRefigureMode (x->column_widget, 1);
1168
1169 /* Force the pane widget to resize itself with the right values. */
1170 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1171
1172 UNBLOCK_INPUT;
1173}
1174
1175void
1176set_frame_menubar (f, first_time)
1177 FRAME_PTR f;
1178 int first_time;
1179{
1180 Widget menubar_widget = f->display.x->menubar_widget;
1181 int id = (int) f;
1182 Lisp_Object tail, items;
1183 widget_value *wv, *save_wv, *first_wv, *prev_wv = 0;
1184 int i;
1185
1186 BLOCK_INPUT;
1187
1188 wv = malloc_widget_value ();
1189 wv->name = "menubar";
1190 wv->value = 0;
1191 wv->enabled = 1;
1192 save_wv = first_wv = wv;
1193
1194 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1195 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1196
1197 for (i = 0; i < XVECTOR (items)->size; i += 3)
1198 {
1199 Lisp_Object string;
1200
1201 string = XVECTOR (items)->contents[i + 1];
1202 if (NILP (string))
1203 break;
1204
1205 wv = malloc_widget_value ();
1206 if (prev_wv)
1207 prev_wv->next = wv;
1208 else
1209 save_wv->contents = wv;
1210 wv->name = (char *) XSTRING (string)->data;
1211 wv->value = 0;
1212 wv->enabled = 1;
1213 prev_wv = wv;
1214 }
1215
1216 if (menubar_widget)
1217 lw_modify_all_widgets (id, first_wv, False);
1218 else
1219 {
1220 menubar_widget = lw_create_widget ("menubar", "menubar",
1221 id, first_wv,
1222 f->display.x->column_widget,
1223 0, 0,
1224 0, 0);
1225 f->display.x->menubar_widget = menubar_widget;
1226 XtVaSetValues (menubar_widget,
1227 XtNshowGrip, 0,
1228 XtNresizeToPreferred, 1,
1229 XtNallowResize, 1,
1230 0);
1231 }
1232
1233 free_menubar_widget_value_tree (first_wv);
1234
1235 /* Don't update the menubar the first time it is created via x_window. */
1236 if (!first_time)
1237 update_frame_menubar (f);
1238
1239 UNBLOCK_INPUT;
1240}
1241
1242void
1243free_frame_menubar (f)
1244 FRAME_PTR f;
1245{
1246 Widget menubar_widget;
1247 int id;
1248
1249 menubar_widget = f->display.x->menubar_widget;
1250 id = (int) f;
1251
1252 if (menubar_widget)
1253 {
1254 BLOCK_INPUT;
1255 lw_destroy_all_widgets (id);
1256 UNBLOCK_INPUT;
1257 }
1258}
1259/* Called from Fx_create_frame to create the inital menubar of a frame
1260 before it is mapped, so that the window is mapped with the menubar already
1261 there instead of us tacking it on later and thrashing the window after it
1262 is visible. */
1263void
1264initialize_frame_menubar (f)
1265 FRAME_PTR f;
1266{
1267 set_frame_menubar (f, 1);
1268}
1269\f
1270/* Horizontal bounds of the current menu bar item. */
1271
1272static int this_menu_bar_item_beg;
1273static int this_menu_bar_item_end;
1274
1275/* Horizontal position of the end of the last menu bar item. */
1276
1277static int last_menu_bar_item_end;
1278
1279/* Nonzero if position X, Y is in the menu bar and in some menu bar item
1280 but not in the current menu bar item. */
1281
1282static int
1283other_menu_bar_item_p (f, x, y)
1284 FRAME_PTR f;
1285 int x, y;
1286{
1287 return (y >= 0
1288 && f->display.x->menubar_widget != 0
1289 && y < f->display.x->menubar_widget->core.height
1290 && x >= 0
1291 && x < last_menu_bar_item_end
1292 && (x >= this_menu_bar_item_end
1293 || x < this_menu_bar_item_beg));
1294}
1295
1296/* Unread a button-press event in the menu bar of frame F
1297 at x position XPOS relative to the inside of the frame. */
1298
1299static void
1300unread_menu_bar_button (f, xpos)
1301 FRAME_PTR f;
1302 int xpos;
1303{
1304 XEvent event;
1305
1306 event.type = ButtonPress;
1307 event.xbutton.display = x_current_display;
1308 event.xbutton.serial = 0;
1309 event.xbutton.send_event = 0;
1310 event.xbutton.time = CurrentTime;
1311 event.xbutton.button = Button1;
1312 event.xbutton.window = XtWindow (f->display.x->menubar_widget);
1313 event.xbutton.x = xpos;
1314 XPutBackEvent (XDISPLAY &event);
1315}
1316
1317/* If the mouse has moved to another menu bar item,
1318 return 1 and unread a button press event for that item.
1319 Otherwise return 0. */
1320
1321static int
1322check_mouse_other_menu_bar (f)
1323 FRAME_PTR f;
1324{
1325 FRAME_PTR new_f;
1326 Lisp_Object bar_window;
1327 int part;
1328 Lisp_Object x, y;
1329 unsigned long time;
1330
1331 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
1332
1333 if (f == new_f && other_menu_bar_item_p (f, x, y))
1334 {
1335 unread_menu_bar_button (f, x);
1336 return 1;
1337 }
1338
1339 return 0;
1340}
1341#endif /* USE_X_TOOLKIT */
1342\f
1343/* xmenu_show actually displays a menu using the panes and items in menu_items
1344 and returns the value selected from it.
1345 There are two versions of xmenu_show, one for Xt and one for Xlib.
1346 Both assume input is blocked by the caller. */
1347
1348/* F is the frame the menu is for.
1349 X and Y are the frame-relative specified position,
1350 relative to the inside upper left corner of the frame F.
1351 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1352 KEYMAPS is 1 if this menu was specified with keymaps;
1353 in that case, we return a list containing the chosen item's value
1354 and perhaps also the pane's prefix.
1355 TITLE is the specified menu title.
1356 ERROR is a place to store an error message string in case of failure.
1357 (We return nil on failure, but the value doesn't actually matter.) */
1358
1359#ifdef USE_X_TOOLKIT
1360
1361extern unsigned int x_mouse_grabbed;
1362extern Lisp_Object Vmouse_depressed;
1363
1364static Lisp_Object
1365xmenu_show (f, x, y, menubarp, keymaps, title, error)
1366 FRAME_PTR f;
1367 int x;
1368 int y;
1369 int menubarp;
1370 int keymaps;
1371 Lisp_Object title;
1372 char **error;
1373{
1374 int i;
1375 int menu_id;
1376 Widget menu;
1377 XlwMenuWidget menubar = (XlwMenuWidget) f->display.x->menubar_widget;
1378
1379 /* This is the menu bar item (if any) that led to this menu. */
1380 widget_value *menubar_item = 0;
1381
1382 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1383 widget_value **submenu_stack
1384 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1385 Lisp_Object *subprefix_stack
1386 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1387 int submenu_depth = 0;
1388
1389 /* Define a queue to save up for later unreading
1390 all X events that don't pertain to the menu. */
1391 struct event_queue
1392 {
1393 XEvent event;
1394 struct event_queue *next;
1395 };
1396
1397 struct event_queue *queue = NULL;
1398 struct event_queue *queue_tmp;
1399
1400 Position root_x, root_y;
1401
1402 int first_pane;
1403
1404 *error = NULL;
1405
1406 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1407 {
1408 *error = "Empty menu";
1409 return Qnil;
1410 }
1411 this_menu_bar_item_beg = -1;
1412 this_menu_bar_item_end = -1;
1413 last_menu_bar_item_end = -1;
1414
1415 /* Figure out which menu bar item, if any, this menu is for. */
1416 if (menubarp)
1417 {
1418 int xbeg;
1419 int xend = 0;
1420 widget_value *mb_item = 0;
1421
1422 for (mb_item = menubar->menu.old_stack[0]->contents;
1423 mb_item;
1424 mb_item = mb_item->next)
1425 {
1426 xbeg = xend;
1427 xend += (string_width (menubar, mb_item->name)
1428 + 2 * (menubar->menu.horizontal_spacing
1429 + menubar->menu.shadow_thickness));
1430 if (x >= xbeg && x < xend)
1431 {
1432 x = xbeg + 4;
1433 y = 0;
1434 menubar_item = mb_item;
1435 /* Arrange to show a different menu if we move in the menu bar
1436 to a different item. */
1437 this_menu_bar_item_beg = xbeg;
1438 this_menu_bar_item_end = xend;
1439 }
1440 }
1441 last_menu_bar_item_end = xend;
1442 }
1443 if (menubar_item == 0)
1444 menubarp = 0;
1445
1446 /* Offset the coordinates to root-relative. */
1447 if (f->display.x->menubar_widget != 0)
1448 y += f->display.x->menubar_widget->core.height;
1449 XtTranslateCoords (f->display.x->widget,
1450 x, y, &root_x, &root_y);
1451 x = root_x;
1452 y = root_y;
1453
1454 /* Create a tree of widget_value objects
1455 representing the panes and their items. */
1456 wv = malloc_widget_value ();
1457 wv->name = "menu";
1458 wv->value = 0;
1459 wv->enabled = 1;
1460 first_wv = wv;
1461 first_pane = 1;
1462
1463 /* Loop over all panes and items, filling in the tree. */
1464 i = 0;
1465 while (i < menu_items_used)
1466 {
1467 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1468 {
1469 submenu_stack[submenu_depth++] = save_wv;
1470 save_wv = prev_wv;
1471 prev_wv = 0;
1472 first_pane = 1;
1473 i++;
1474 }
1475 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1476 {
1477 prev_wv = save_wv;
1478 save_wv = submenu_stack[--submenu_depth];
1479 first_pane = 0;
1480 i++;
1481 }
1482 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1483 && submenu_depth != 0)
1484 i += MENU_ITEMS_PANE_LENGTH;
1485 /* Ignore a nil in the item list.
1486 It's meaningful only for dialog boxes. */
1487 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1488 i += 1;
1489 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1490 {
1491 /* Create a new pane. */
1492 Lisp_Object pane_name, prefix;
1493 char *pane_string;
1494 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1495 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1496 pane_string = (NILP (pane_name)
1497 ? "" : (char *) XSTRING (pane_name)->data);
1498 /* If there is just one top-level pane, put all its items directly
1499 under the top-level menu. */
1500 if (menu_items_n_panes == 1)
1501 pane_string = "";
1502
1503 /* If the pane has a meaningful name,
1504 make the pane a top-level menu item
1505 with its items as a submenu beneath it. */
1506 if (!keymaps && strcmp (pane_string, ""))
1507 {
1508 wv = malloc_widget_value ();
1509 if (save_wv)
1510 save_wv->next = wv;
1511 else
1512 first_wv->contents = wv;
1513 wv->name = pane_string;
1514 if (keymaps && !NILP (prefix))
1515 wv->name++;
1516 wv->value = 0;
1517 wv->enabled = 1;
1518 save_wv = wv;
1519 prev_wv = 0;
1520 }
1521 else if (first_pane)
1522 {
1523 save_wv = wv;
1524 prev_wv = 0;
1525 }
1526 first_pane = 0;
1527 i += MENU_ITEMS_PANE_LENGTH;
1528 }
1529 else
1530 {
1531 /* Create a new item within current pane. */
1532 Lisp_Object item_name, enable, descrip;
1533 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1534 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1535 descrip
1536 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1537
1538 wv = malloc_widget_value ();
1539 if (prev_wv)
1540 prev_wv->next = wv;
1541 else
1542 save_wv->contents = wv;
1543 wv->name = (char *) XSTRING (item_name)->data;
1544 if (!NILP (descrip))
1545 wv->key = (char *) XSTRING (descrip)->data;
1546 wv->value = 0;
1547 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1548 wv->enabled = !NILP (enable);
1549 prev_wv = wv;
1550
1551 i += MENU_ITEMS_ITEM_LENGTH;
1552 }
1553 }
1554
1555 /* Actually create the menu. */
1556 menu_id = ++popup_id_tick;
1557 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
1558 f->display.x->widget, 1, 0,
1559 popup_selection_callback, popup_down_callback);
1560 /* Free the widget_value objects we used to specify the contents. */
1561 free_menubar_widget_value_tree (first_wv);
1562
1563 /* No selection has been chosen yet. */
1564 menu_item_selection = 0;
1565
1566 /* If the mouse moves out of the menu before we show the menu,
1567 don't show it at all. */
1568 if (check_mouse_other_menu_bar (f))
1569 {
1570 lw_destroy_all_widgets (menu_id);
1571 return Qnil;
1572 }
1573
1574
1575 /* Highlight the menu bar item (if any) that led to this menu. */
1576 if (menubarp)
1577 {
1578 menubar_item->call_data = (XtPointer) 1;
1579 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
1580 }
1581
1582 /* Display the menu. */
1583 {
1584 XButtonPressedEvent dummy;
1585 XlwMenuWidget mw;
1586
1587 mw = (XlwMenuWidget) ((CompositeWidget)menu)->composite.children[0];
1588
1589 dummy.type = ButtonPress;
1590 dummy.serial = 0;
1591 dummy.send_event = 0;
1592 dummy.display = XtDisplay (menu);
1593 dummy.window = XtWindow (XtParent (menu));
1594 dummy.time = CurrentTime;
1595 dummy.button = 0;
1596 dummy.x_root = x;
1597 dummy.y_root = y;
1598
1599 /* We activate directly the lucid implementation. */
1600 pop_up_menu (mw, &dummy);
1601 }
1602
1603 /* No need to check a second time since this is done in the XEvent loop.
1604 This slows done the execution. */
1605#if 0
1606 /* Check again whether the mouse has moved to another menu bar item. */
1607 if (check_mouse_other_menu_bar (f))
1608 {
1609 /* The mouse moved into a different menu bar item.
1610 We should bring up that item's menu instead.
1611 First pop down this menu. */
1612 XtUngrabPointer ((Widget)
1613 ((XlwMenuWidget)
1614 ((CompositeWidget)menu)->composite.children[0]),
1615 CurrentTime);
1616 lw_destroy_all_widgets (menu_id);
1617 goto pop_down;
1618 }
1619#endif
1620
1621 /* Process events that apply to the menu. */
1622 while (1)
1623 {
1624 XEvent event;
1625
1626 XtAppNextEvent (Xt_app_con, &event);
1627 if (event.type == ButtonRelease)
1628 {
1629 XtDispatchEvent (&event);
1630 if (! menubarp)
1631 {
1632 /* Do the work of construct_mouse_click since it can't
1633 be called. Initially, the popup menu has been called
1634 from a ButtonPress in the edit_widget. Then the mouse
1635 has been set to grabbed. Reset it now. */
1636 x_mouse_grabbed &= ~(1 << event.xbutton.button);
1637 if (!x_mouse_grabbed)
1638 Vmouse_depressed = Qnil;
1639 }
1640 break;
1641 }
1642 else if (event.type == Expose)
1643 process_expose_from_menu (event);
1644 else if (event.type == MotionNotify)
1645 {
1646 int event_x = (event.xmotion.x_root
1647 - (f->display.x->widget->core.x
1648 + f->display.x->widget->core.border_width));
1649 int event_y = (event.xmotion.y_root
1650 - (f->display.x->widget->core.y
1651 + f->display.x->widget->core.border_width));
1652
1653 if (other_menu_bar_item_p (f, event_x, event_y))
1654 {
1655 /* The mouse moved into a different menu bar item.
1656 We should bring up that item's menu instead.
1657 First pop down this menu. */
1658 XtUngrabPointer ((Widget)
1659 ((XlwMenuWidget)
1660 ((CompositeWidget)menu)->composite.children[0]),
1661 event.xbutton.time);
1662 lw_destroy_all_widgets (menu_id);
1663
1664 /* Put back an event that will bring up the other item's menu. */
1665 unread_menu_bar_button (f, event_x);
1666 /* Don't let us select anything in this case. */
1667 menu_item_selection = 0;
1668 break;
1669 }
1670 }
1671
1672 XtDispatchEvent (&event);
1673 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1674 {
1675 queue_tmp
1676 = (struct event_queue *) malloc (sizeof (struct event_queue));
1677
1678 if (queue_tmp != NULL)
1679 {
1680 queue_tmp->event = event;
1681 queue_tmp->next = queue;
1682 queue = queue_tmp;
1683 }
1684 }
1685 }
1686
1687 pop_down:
1688 /* Unhighlight the menu bar item (if any) that led to this menu. */
1689 if (menubarp)
1690 {
1691 menubar_item->call_data = (XtPointer) 0;
1692 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
1693 }
1694
1695 /* fp turned off the following statement and wrote a comment
1696 that it is unnecessary--that the menu has already disappeared.
1697 I observer that is not so. -- rms. */
1698 /* Make sure the menu disappears. */
1699 lw_destroy_all_widgets (menu_id);
1700
1701 /* Unread any events that we got but did not handle. */
1702 while (queue != NULL)
1703 {
1704 queue_tmp = queue;
1705 XPutBackEvent (XDISPLAY &queue_tmp->event);
1706 queue = queue_tmp->next;
1707 free ((char *)queue_tmp);
1708 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1709 interrupt_input_pending = 1;
1710 }
1711
1712 /* Find the selected item, and its pane, to return
1713 the proper value. */
1714 if (menu_item_selection != 0)
1715 {
1716 Lisp_Object prefix;
1717
1718 prefix = Qnil;
1719 i = 0;
1720 while (i < menu_items_used)
1721 {
1722 Lisp_Object entry;
1723
1724 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1725 {
1726 subprefix_stack[submenu_depth++] = prefix;
1727 prefix = entry;
1728 i++;
1729 }
1730 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1731 {
1732 prefix = subprefix_stack[--submenu_depth];
1733 i++;
1734 }
1735 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1736 {
1737 prefix
1738 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1739 i += MENU_ITEMS_PANE_LENGTH;
1740 }
1741 else
1742 {
1743 entry
1744 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1745 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1746 {
1747 if (keymaps != 0)
1748 {
1749 int j;
1750
1751 entry = Fcons (entry, Qnil);
1752 if (!NILP (prefix))
1753 entry = Fcons (prefix, entry);
1754 for (j = submenu_depth - 1; j >= 0; j--)
1755 if (!NILP (subprefix_stack[j]))
1756 entry = Fcons (subprefix_stack[j], entry);
1757 }
1758 return entry;
1759 }
1760 i += MENU_ITEMS_ITEM_LENGTH;
1761 }
1762 }
1763 }
1764
1765 return Qnil;
1766}
1767
1768static char * button_names [] = {
1769 "button1", "button2", "button3", "button4", "button5",
1770 "button6", "button7", "button8", "button9", "button10" };
1771
1772static Lisp_Object
1773xdialog_show (f, menubarp, keymaps, title, error)
1774 FRAME_PTR f;
1775 int menubarp;
1776 int keymaps;
1777 Lisp_Object title;
1778 char **error;
1779{
1780 int i, nb_buttons=0;
1781 int dialog_id;
1782 Widget menu;
1783 XlwMenuWidget menubar = (XlwMenuWidget) f->display.x->menubar_widget;
1784 char dialog_name[6];
1785
1786 /* This is the menu bar item (if any) that led to this menu. */
1787 widget_value *menubar_item = 0;
1788
1789 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1790
1791 /* Define a queue to save up for later unreading
1792 all X events that don't pertain to the menu. */
1793 struct event_queue
1794 {
1795 XEvent event;
1796 struct event_queue *next;
1797 };
1798
1799 struct event_queue *queue = NULL;
1800 struct event_queue *queue_tmp;
1801
1802 /* Number of elements seen so far, before boundary. */
1803 int left_count = 0;
1804 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1805 int boundary_seen = 0;
1806
1807 *error = NULL;
1808
1809 if (menu_items_n_panes > 1)
1810 {
1811 *error = "Multiple panes in dialog box";
1812 return Qnil;
1813 }
1814
1815 /* Create a tree of widget_value objects
1816 representing the text label and buttons. */
1817 {
1818 Lisp_Object pane_name, prefix;
1819 char *pane_string;
1820 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1821 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1822 pane_string = (NILP (pane_name)
1823 ? "" : (char *) XSTRING (pane_name)->data);
1824 prev_wv = malloc_widget_value ();
1825 prev_wv->value = pane_string;
1826 if (keymaps && !NILP (prefix))
1827 prev_wv->name++;
1828 prev_wv->enabled = 1;
1829 prev_wv->name = "message";
1830 first_wv = prev_wv;
1831
1832 /* Loop over all panes and items, filling in the tree. */
1833 i = MENU_ITEMS_PANE_LENGTH;
1834 while (i < menu_items_used)
1835 {
1836
1837 /* Create a new item within current pane. */
1838 Lisp_Object item_name, enable, descrip;
1839 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1840 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1841 descrip
1842 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1843
1844 if (NILP (item_name))
1845 {
1846 free_menubar_widget_value_tree (first_wv);
1847 *error = "Submenu in dialog items";
1848 return Qnil;
1849 }
1850 if (EQ (item_name, Qquote))
1851 {
1852 /* This is the boundary between left-side elts
1853 and right-side elts. Stop incrementing right_count. */
1854 boundary_seen = 1;
1855 i++;
1856 continue;
1857 }
1858 if (nb_buttons >= 10)
1859 {
1860 free_menubar_widget_value_tree (first_wv);
1861 *error = "Too many dialog items";
1862 return Qnil;
1863 }
1864
1865 wv = malloc_widget_value ();
1866 prev_wv->next = wv;
1867 wv->name = (char *) button_names[nb_buttons];
1868 if (!NILP (descrip))
1869 wv->key = (char *) XSTRING (descrip)->data;
1870 wv->value = (char *) XSTRING (item_name)->data;
1871 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1872 wv->enabled = !NILP (enable);
1873 prev_wv = wv;
1874
1875 if (! boundary_seen)
1876 left_count++;
1877
1878 nb_buttons++;
1879 i += MENU_ITEMS_ITEM_LENGTH;
1880 }
1881
1882 /* If the boundary was not specified,
1883 by default put half on the left and half on the right. */
1884 if (! boundary_seen)
1885 left_count = nb_buttons - nb_buttons / 2;
1886
1887 wv = malloc_widget_value ();
1888 wv->name = dialog_name;
1889
1890 /* Dialog boxes use a really stupid name encoding
1891 which specifies how many buttons to use
1892 and how many buttons are on the right.
1893 The Q means something also. */
1894 dialog_name[0] = 'Q';
1895 dialog_name[1] = '0' + nb_buttons;
1896 dialog_name[2] = 'B';
1897 dialog_name[3] = 'R';
1898 /* Number of buttons to put on the right. */
1899 dialog_name[4] = '0' + nb_buttons - left_count;
1900 dialog_name[5] = 0;
1901 wv->contents = first_wv;
1902 first_wv = wv;
1903 }
1904
1905 /* Actually create the dialog. */
1906 dialog_id = ++popup_id_tick;
1907 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1908 f->display.x->widget, 1, 0,
1909 dialog_selection_callback, 0);
1910#if 0 /* This causes crashes, and seems to be redundant -- rms. */
1911 lw_modify_all_widgets (dialog_id, first_wv, True);
1912#endif
1913 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1914 /* Free the widget_value objects we used to specify the contents. */
1915 free_menubar_widget_value_tree (first_wv);
1916
1917 /* No selection has been chosen yet. */
1918 menu_item_selection = 0;
1919
1920 /* Display the menu. */
1921 lw_pop_up_all_widgets (dialog_id);
1922
1923 /* Process events that apply to the menu. */
1924 while (1)
1925 {
1926 XEvent event;
1927
1928 XtAppNextEvent (Xt_app_con, &event);
1929 if (event.type == ButtonRelease)
1930 {
1931 XtDispatchEvent (&event);
1932 break;
1933 }
1934 else if (event.type == Expose)
1935 process_expose_from_menu (event);
1936 XtDispatchEvent (&event);
1937 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1938 {
1939 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1940
1941 if (queue_tmp != NULL)
1942 {
1943 queue_tmp->event = event;
1944 queue_tmp->next = queue;
1945 queue = queue_tmp;
1946 }
1947 }
1948 }
1949 pop_down:
1950
1951 /* State that no mouse buttons are now held.
1952 That is not necessarily true, but the fiction leads to reasonable
1953 results, and it is a pain to ask which are actually held now
1954 or track this in the loop above. */
1955 x_mouse_grabbed = 0;
1956
1957 /* Unread any events that we got but did not handle. */
1958 while (queue != NULL)
1959 {
1960 queue_tmp = queue;
1961 XPutBackEvent (XDISPLAY &queue_tmp->event);
1962 queue = queue_tmp->next;
1963 free ((char *)queue_tmp);
1964 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1965 interrupt_input_pending = 1;
1966 }
1967
1968 /* Find the selected item, and its pane, to return
1969 the proper value. */
1970 if (menu_item_selection != 0)
1971 {
1972 Lisp_Object prefix;
1973
1974 prefix = Qnil;
1975 i = 0;
1976 while (i < menu_items_used)
1977 {
1978 Lisp_Object entry;
1979
1980 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1981 {
1982 prefix
1983 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1984 i += MENU_ITEMS_PANE_LENGTH;
1985 }
1986 else
1987 {
1988 entry
1989 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1990 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1991 {
1992 if (keymaps != 0)
1993 {
1994 entry = Fcons (entry, Qnil);
1995 if (!NILP (prefix))
1996 entry = Fcons (prefix, entry);
1997 }
1998 return entry;
1999 }
2000 i += MENU_ITEMS_ITEM_LENGTH;
2001 }
2002 }
2003 }
2004
2005 return Qnil;
2006}
2007#else /* not USE_X_TOOLKIT */
2008
2009static Lisp_Object
2010xmenu_show (f, x, y, menubarp, keymaps, title, error)
2011 FRAME_PTR f;
2012 int x, y;
2013 int keymaps;
2014 int menubarp;
2015 Lisp_Object title;
2016 char **error;
2017{
2018 Window root;
2019 XMenu *menu;
2020 int pane, selidx, lpane, status;
2021 Lisp_Object entry, pane_prefix;
2022 char *datap;
2023 int ulx, uly, width, height;
2024 int dispwidth, dispheight;
2025 int i, j;
2026 int maxwidth;
2027 int dummy_int;
2028 unsigned int dummy_uint;
2029
2030 *error = 0;
2031 if (menu_items_n_panes == 0)
2032 return Qnil;
2033
2034 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
2035 {
2036 *error = "Empty menu";
2037 return Qnil;
2038 }
2039
2040 /* Figure out which root window F is on. */
2041 XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root,
2042 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
2043 &dummy_uint, &dummy_uint);
2044
2045 /* Make the menu on that window. */
2046 menu = XMenuCreate (XDISPLAY root, "emacs");
2047 if (menu == NULL)
2048 {
2049 *error = "Can't create menu";
2050 return Qnil;
2051 }
2052
2053 /* Adjust coordinates to relative to the outer (window manager) window. */
2054#ifdef HAVE_X11
2055 {
2056 Window child;
2057 int win_x = 0, win_y = 0;
2058
2059 /* Find the position of the outside upper-left corner of
2060 the inner window, with respect to the outer window. */
2061 if (f->display.x->parent_desc != ROOT_WINDOW)
2062 {
2063 BLOCK_INPUT;
2064 XTranslateCoordinates (x_current_display,
2065
2066 /* From-window, to-window. */
2067 f->display.x->window_desc,
2068 f->display.x->parent_desc,
2069
2070 /* From-position, to-position. */
2071 0, 0, &win_x, &win_y,
2072
2073 /* Child of window. */
2074 &child);
2075 UNBLOCK_INPUT;
2076 x += win_x;
2077 y += win_y;
2078 }
2079 }
2080#endif /* HAVE_X11 */
2081
2082 /* Adjust coordinates to be root-window-relative. */
2083 x += f->display.x->left_pos;
2084 y += f->display.x->top_pos;
2085
2086 /* Create all the necessary panes and their items. */
2087 i = 0;
2088 while (i < menu_items_used)
2089 {
2090 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2091 {
2092 /* Create a new pane. */
2093 Lisp_Object pane_name, prefix;
2094 char *pane_string;
2095
2096 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
2097 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2098 pane_string = (NILP (pane_name)
2099 ? "" : (char *) XSTRING (pane_name)->data);
2100 if (keymaps && !NILP (prefix))
2101 pane_string++;
2102
2103 lpane = XMenuAddPane (XDISPLAY menu, pane_string, TRUE);
2104 if (lpane == XM_FAILURE)
2105 {
2106 XMenuDestroy (XDISPLAY menu);
2107 *error = "Can't create pane";
2108 return Qnil;
2109 }
2110 i += MENU_ITEMS_PANE_LENGTH;
2111
2112 /* Find the width of the widest item in this pane. */
2113 maxwidth = 0;
2114 j = i;
2115 while (j < menu_items_used)
2116 {
2117 Lisp_Object item;
2118 item = XVECTOR (menu_items)->contents[j];
2119 if (EQ (item, Qt))
2120 break;
2121 if (NILP (item))
2122 {
2123 j++;
2124 continue;
2125 }
2126 width = XSTRING (item)->size;
2127 if (width > maxwidth)
2128 maxwidth = width;
2129
2130 j += MENU_ITEMS_ITEM_LENGTH;
2131 }
2132 }
2133 /* Ignore a nil in the item list.
2134 It's meaningful only for dialog boxes. */
2135 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2136 i += 1;
2137 else
2138 {
2139 /* Create a new item within current pane. */
2140 Lisp_Object item_name, enable, descrip;
2141 unsigned char *item_data;
2142
2143 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2144 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2145 descrip
2146 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2147 if (!NILP (descrip))
2148 {
2149 int gap = maxwidth - XSTRING (item_name)->size;
2150#ifdef C_ALLOCA
2151 Lisp_Object spacer;
2152 spacer = Fmake_string (make_number (gap), make_number (' '));
2153 item_name = concat2 (item_name, spacer);
2154 item_name = concat2 (item_name, descrip);
2155 item_data = XSTRING (item_name)->data;
2156#else
2157 /* if alloca is fast, use that to make the space,
2158 to reduce gc needs. */
2159 item_data
2160 = (unsigned char *) alloca (maxwidth
2161 + XSTRING (descrip)->size + 1);
2162 bcopy (XSTRING (item_name)->data, item_data,
2163 XSTRING (item_name)->size);
2164 for (j = XSTRING (item_name)->size; j < maxwidth; j++)
2165 item_data[j] = ' ';
2166 bcopy (XSTRING (descrip)->data, item_data + j,
2167 XSTRING (descrip)->size);
2168 item_data[j + XSTRING (descrip)->size] = 0;
2169#endif
2170 }
2171 else
2172 item_data = XSTRING (item_name)->data;
2173
2174 if (XMenuAddSelection (XDISPLAY menu, lpane, 0, item_data,
2175 !NILP (enable))
2176 == XM_FAILURE)
2177 {
2178 XMenuDestroy (XDISPLAY menu);
2179 *error = "Can't add selection to menu";
2180 return Qnil;
2181 }
2182 i += MENU_ITEMS_ITEM_LENGTH;
2183 }
2184 }
2185
2186 /* All set and ready to fly. */
2187 XMenuRecompute (XDISPLAY menu);
2188 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
2189 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
2190 x = min (x, dispwidth);
2191 y = min (y, dispheight);
2192 x = max (x, 1);
2193 y = max (y, 1);
2194 XMenuLocate (XDISPLAY menu, 0, 0, x, y,
2195 &ulx, &uly, &width, &height);
2196 if (ulx+width > dispwidth)
2197 {
2198 x -= (ulx + width) - dispwidth;
2199 ulx = dispwidth - width;
2200 }
2201 if (uly+height > dispheight)
2202 {
2203 y -= (uly + height) - dispheight;
2204 uly = dispheight - height;
2205 }
2206 if (ulx < 0) x -= ulx;
2207 if (uly < 0) y -= uly;
2208
2209 XMenuSetAEQ (menu, TRUE);
2210 XMenuSetFreeze (menu, TRUE);
2211 pane = selidx = 0;
2212
2213 status = XMenuActivate (XDISPLAY menu, &pane, &selidx,
2214 x, y, ButtonReleaseMask, &datap);
2215 switch (status)
2216 {
2217 case XM_SUCCESS:
2218#ifdef XDEBUG
2219 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2220#endif
2221
2222 /* Find the item number SELIDX in pane number PANE. */
2223 i = 0;
2224 while (i < menu_items_used)
2225 {
2226 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2227 {
2228 if (pane == 0)
2229 pane_prefix
2230 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2231 pane--;
2232 i += MENU_ITEMS_PANE_LENGTH;
2233 }
2234 else
2235 {
2236 if (pane == -1)
2237 {
2238 if (selidx == 0)
2239 {
2240 entry
2241 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2242 if (keymaps != 0)
2243 {
2244 entry = Fcons (entry, Qnil);
2245 if (!NILP (pane_prefix))
2246 entry = Fcons (pane_prefix, entry);
2247 }
2248 break;
2249 }
2250 selidx--;
2251 }
2252 i += MENU_ITEMS_ITEM_LENGTH;
2253 }
2254 }
2255 break;
2256
2257 case XM_FAILURE:
2258 *error = "Can't activate menu";
2259 case XM_IA_SELECT:
2260 case XM_NO_SELECT:
2261 entry = Qnil;
2262 break;
2263 }
2264 XMenuDestroy (XDISPLAY menu);
2265
2266 /* State that no mouse buttons are now held.
2267 (The oldXMenu code doesn't track this info for us.)
2268 That is not necessarily true, but the fiction leads to reasonable
2269 results, and it is a pain to ask which are actually held now. */
2270 x_mouse_grabbed = 0;
2271
2272 return entry;
2273}
2274#endif /* not USE_X_TOOLKIT */
2275\f
2276syms_of_xmenu ()
2277{
2278 staticpro (&menu_items);
2279 menu_items = Qnil;
2280
2281 popup_id_tick = (1<<16);
2282 defsubr (&Sx_popup_menu);
2283 defsubr (&Sx_popup_dialog);
2284}