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