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