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