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