(xmenu_show): Undo part of March 11 change:
[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, 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, 2, 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 = 0;
676 Lisp_Object bar_window;
677 int part;
678 unsigned long time;
679
680 if (new_f != 0)
681 XSET (window, Lisp_Frame, new_f);
682 else
683 {
684 window = selected_window;
685 XFASTINT (x) = 0;
686 XFASTINT (y) = 0;
687 }
688 }
689 else
690 {
691 tem = Fcar (position);
692 if (XTYPE (tem) == Lisp_Cons)
693 {
694 window = Fcar (Fcdr (position));
695 x = Fcar (tem);
696 y = Fcar (Fcdr (tem));
697 }
698 else
699 {
700 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
701 window = Fcar (tem); /* POSN_WINDOW (tem) */
702 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
703 x = Fcar (tem);
704 y = Fcdr (tem);
705
706 /* Determine whether this menu is handling a menu bar click. */
707 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
708 if (XTYPE (Fcar (position)) != Lisp_Cons
709 && CONSP (tem)
710 && EQ (Fcar (tem), Qmenu_bar))
711 menubarp = 1;
712 }
713 }
714
715 CHECK_NUMBER (x, 0);
716 CHECK_NUMBER (y, 0);
717
718 /* Decode where to put the menu. */
719
720 if (XTYPE (window) == Lisp_Frame)
721 {
722 f = XFRAME (window);
723
724 xpos = 0;
725 ypos = 0;
726 }
727 else if (XTYPE (window) == Lisp_Window)
728 {
729 CHECK_LIVE_WINDOW (window, 0);
730 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
731
732 xpos = (FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left);
733 ypos = (FONT_HEIGHT (f->display.x->font) * XWINDOW (window)->top);
734 }
735 else
736 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
737 but I don't want to make one now. */
738 CHECK_WINDOW (window, 0);
739
740 xpos += XINT (x);
741 ypos += XINT (y);
742 }
743
744 title = Qnil;
745 GCPRO1 (title);
746
747 /* Decode the menu items from what was specified. */
748
749 keymap = Fkeymapp (menu);
750 tem = Qnil;
751 if (XTYPE (menu) == Lisp_Cons)
752 tem = Fkeymapp (Fcar (menu));
753 if (!NILP (keymap))
754 {
755 /* We were given a keymap. Extract menu info from the keymap. */
756 Lisp_Object prompt;
757 keymap = get_keymap (menu);
758
759 /* Extract the detailed info to make one pane. */
760 keymap_panes (&menu, 1, NILP (position));
761
762 /* Search for a string appearing directly as an element of the keymap.
763 That string is the title of the menu. */
764 prompt = map_prompt (keymap);
765
766 /* Make that be the pane title of the first pane. */
767 if (!NILP (prompt) && menu_items_n_panes >= 0)
768 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
769
770 keymaps = 1;
771 }
772 else if (!NILP (tem))
773 {
774 /* We were given a list of keymaps. */
775 int nmaps = XFASTINT (Flength (menu));
776 Lisp_Object *maps
777 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
778 int i;
779
780 title = Qnil;
781
782 /* The first keymap that has a prompt string
783 supplies the menu title. */
784 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
785 {
786 Lisp_Object prompt;
787
788 maps[i++] = keymap = get_keymap (Fcar (tem));
789
790 prompt = map_prompt (keymap);
791 if (NILP (title) && !NILP (prompt))
792 title = prompt;
793 }
794
795 /* Extract the detailed info to make one pane. */
796 keymap_panes (maps, nmaps, NILP (position));
797
798 /* Make the title be the pane title of the first pane. */
799 if (!NILP (title) && menu_items_n_panes >= 0)
800 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
801
802 keymaps = 1;
803 }
804 else
805 {
806 /* We were given an old-fashioned menu. */
807 title = Fcar (menu);
808 CHECK_STRING (title, 1);
809
810 list_of_panes (Fcdr (menu));
811
812 keymaps = 0;
813 }
814
815 if (NILP (position))
816 {
817 discard_menu_items ();
818 UNGCPRO;
819 return Qnil;
820 }
821
822 /* Display them in a menu. */
823 BLOCK_INPUT;
824
825 selection = xmenu_show (f, xpos, ypos, menubarp,
826 keymaps, title, &error_name);
827 UNBLOCK_INPUT;
828
829 discard_menu_items ();
830
831 UNGCPRO;
832
833 if (error_name) error (error_name);
834 return selection;
835 }
836
837 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
838 "Pop up a dialog box and return user's selection.\n\
839 POSITION specifies which frame to use.\n\
840 This is normally a mouse button event or a window or frame.\n\
841 If POSITION is t, it means to use the frame the mouse is on.\n\
842 The dialog box appears in the middle of the specified frame.\n\
843 \n\
844 CONTENTS specifies the alternatives to display in the dialog box.\n\
845 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
846 Each ITEM is a cons cell (STRING . VALUE).\n\
847 The return value is VALUE from the chosen item.")
848 (position, contents)
849 Lisp_Object position, contents;
850 {
851 FRAME_PTR f;
852 Lisp_Object window;
853
854 check_x ();
855
856 /* Decode the first argument: find the window or frame to use. */
857 if (EQ (position, Qt))
858 {
859 /* Use the mouse's current position. */
860 FRAME_PTR new_f = 0;
861 Lisp_Object bar_window;
862 int part;
863 unsigned long time;
864 Lisp_Object x, y;
865
866 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
867
868 if (new_f != 0)
869 XSET (window, Lisp_Frame, new_f);
870 else
871 window = selected_window;
872 }
873 else if (CONSP (position))
874 {
875 Lisp_Object tem;
876 tem = Fcar (position);
877 if (XTYPE (tem) == Lisp_Cons)
878 window = Fcar (Fcdr (position));
879 else
880 {
881 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
882 window = Fcar (tem); /* POSN_WINDOW (tem) */
883 }
884 }
885 else if (WINDOWP (position) || FRAMEP (position))
886 window = position;
887
888 /* Decode where to put the menu. */
889
890 if (XTYPE (window) == Lisp_Frame)
891 f = XFRAME (window);
892 else if (XTYPE (window) == Lisp_Window)
893 {
894 CHECK_LIVE_WINDOW (window, 0);
895 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
896 }
897 else
898 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
899 but I don't want to make one now. */
900 CHECK_WINDOW (window, 0);
901
902 #ifndef USE_X_TOOLKIT
903 /* Display a menu with these alternatives
904 in the middle of frame F. */
905 {
906 Lisp_Object x, y, frame, newpos;
907 XSET (frame, Lisp_Frame, f);
908 XSET (x, Lisp_Int, x_pixel_width (f) / 2);
909 XSET (y, Lisp_Int, x_pixel_height (f) / 2);
910 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
911
912 return Fx_popup_menu (newpos,
913 Fcons (Fcar (contents), Fcons (contents, Qnil)));
914 }
915 #else
916 {
917 Lisp_Object title;
918 char *error_name;
919 Lisp_Object selection;
920
921 /* Decode the dialog items from what was specified. */
922 title = Fcar (contents);
923 CHECK_STRING (title, 1);
924
925 list_of_panes (Fcons (contents, Qnil));
926
927 /* Display them in a dialog box. */
928 BLOCK_INPUT;
929 selection = xdialog_show (f, 0, 0, title, &error_name);
930 UNBLOCK_INPUT;
931
932 discard_menu_items ();
933
934 if (error_name) error (error_name);
935 return selection;
936 }
937 #endif
938 }
939 \f
940 #ifdef USE_X_TOOLKIT
941
942 static void
943 dispatch_dummy_expose (w, x, y)
944 Widget w;
945 int x;
946 int y;
947 {
948 XExposeEvent dummy;
949
950 dummy.type = Expose;
951 dummy.window = XtWindow (w);
952 dummy.count = 0;
953 dummy.serial = 0;
954 dummy.send_event = 0;
955 dummy.display = XtDisplay (w);
956 dummy.x = x;
957 dummy.y = y;
958
959 XtDispatchEvent (&dummy);
960 }
961
962 static int
963 string_width (mw, s)
964 XlwMenuWidget mw;
965 char* s;
966 {
967 XCharStruct xcs;
968 int drop;
969
970 XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs);
971 return xcs.width;
972 }
973
974 static int
975 event_is_in_menu_item (mw, event, name, string_w)
976 XlwMenuWidget mw;
977 struct input_event *event;
978 char *name;
979 int *string_w;
980 {
981 *string_w += (string_width (mw, name)
982 + 2 * (mw->menu.horizontal_spacing
983 + mw->menu.shadow_thickness));
984 return XINT (event->x) < *string_w;
985 }
986
987
988 /* Return the menu bar key which corresponds to event EVENT in frame F. */
989
990 Lisp_Object
991 map_event_to_object (event, f)
992 struct input_event *event;
993 FRAME_PTR f;
994 {
995 int i,j, string_w;
996 window_state* ws;
997 XlwMenuWidget mw = (XlwMenuWidget) f->display.x->menubar_widget;
998 widget_value *val;
999
1000
1001 string_w = 0;
1002 /* Find the window */
1003 for (val = mw->menu.old_stack [0]->contents; val; val = val->next)
1004 {
1005 ws = &mw->menu.windows [0];
1006 if (ws && event_is_in_menu_item (mw, event, val->name, &string_w))
1007 {
1008 Lisp_Object items;
1009 int i;
1010
1011 items = FRAME_MENU_BAR_ITEMS (f);
1012
1013 for (i = 0; i < XVECTOR (items)->size; i += 3)
1014 {
1015 Lisp_Object pos, string, item;
1016 item = XVECTOR (items)->contents[i];
1017 string = XVECTOR (items)->contents[i + 1];
1018 pos = XVECTOR (items)->contents[i + 2];
1019 if (NILP (string))
1020 break;
1021
1022 if (!strcmp (val->name, XSTRING (string)->data))
1023 return item;
1024 }
1025 }
1026 }
1027 return Qnil;
1028 }
1029
1030 static Lisp_Object *menu_item_selection;
1031
1032 static void
1033 popup_selection_callback (widget, id, client_data)
1034 Widget widget;
1035 LWLIB_ID id;
1036 XtPointer client_data;
1037 {
1038 menu_item_selection = (Lisp_Object *) client_data;
1039 }
1040
1041 static void
1042 popup_down_callback (widget, id, client_data)
1043 Widget widget;
1044 LWLIB_ID id;
1045 XtPointer client_data;
1046 {
1047 BLOCK_INPUT;
1048 lw_destroy_all_widgets (id);
1049 UNBLOCK_INPUT;
1050 }
1051
1052 static void
1053 dialog_selection_callback (widget, id, client_data)
1054 Widget widget;
1055 LWLIB_ID id;
1056 XtPointer client_data;
1057 {
1058 if ((int)client_data != -1)
1059 menu_item_selection = (Lisp_Object *) client_data;
1060 BLOCK_INPUT;
1061 lw_destroy_all_widgets (id);
1062 UNBLOCK_INPUT;
1063 }
1064
1065 /* This recursively calls free_widget_value() on the tree of widgets.
1066 It must free all data that was malloc'ed for these widget_values.
1067 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1068 must be left alone. */
1069
1070 void
1071 free_menubar_widget_value_tree (wv)
1072 widget_value *wv;
1073 {
1074 if (! wv) return;
1075
1076 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1077
1078 if (wv->contents && (wv->contents != (widget_value*)1))
1079 {
1080 free_menubar_widget_value_tree (wv->contents);
1081 wv->contents = (widget_value *) 0xDEADBEEF;
1082 }
1083 if (wv->next)
1084 {
1085 free_menubar_widget_value_tree (wv->next);
1086 wv->next = (widget_value *) 0xDEADBEEF;
1087 }
1088 BLOCK_INPUT;
1089 free_widget_value (wv);
1090 UNBLOCK_INPUT;
1091 }
1092
1093 extern void EmacsFrameSetCharSize ();
1094
1095 static void
1096 update_frame_menubar (f)
1097 FRAME_PTR f;
1098 {
1099 struct x_display *x = f->display.x;
1100 int columns, rows;
1101 int menubar_changed;
1102
1103 menubar_changed = (x->menubar_widget
1104 && !XtIsManaged (x->menubar_widget));
1105
1106 if (! (menubar_changed))
1107 return;
1108
1109 BLOCK_INPUT;
1110 /* Save the size of the frame because the pane widget doesn't accept to
1111 resize itself. So force it. */
1112 columns = f->width;
1113 rows = f->height;
1114
1115
1116 XawPanedSetRefigureMode (x->column_widget, 0);
1117
1118 /* the order in which children are managed is the top to
1119 bottom order in which they are displayed in the paned window.
1120 First, remove the text-area widget.
1121 */
1122 XtUnmanageChild (x->edit_widget);
1123
1124 /* remove the menubar that is there now, and put up the menubar that
1125 should be there.
1126 */
1127 if (menubar_changed)
1128 {
1129 XtManageChild (x->menubar_widget);
1130 XtMapWidget (x->menubar_widget);
1131 XtVaSetValues (x->menubar_widget, XtNmappedWhenManaged, 1, 0);
1132 }
1133
1134
1135 /* Re-manage the text-area widget */
1136 XtManageChild (x->edit_widget);
1137
1138 /* and now thrash the sizes */
1139 XawPanedSetRefigureMode (x->column_widget, 1);
1140
1141 /* Force the pane widget to resize itself with the right values. */
1142 EmacsFrameSetCharSize (x->edit_widget, columns, rows);
1143
1144 UNBLOCK_INPUT;
1145 }
1146
1147 void
1148 set_frame_menubar (f, first_time)
1149 FRAME_PTR f;
1150 int first_time;
1151 {
1152 Widget menubar_widget = f->display.x->menubar_widget;
1153 int id = (int) f;
1154 Lisp_Object tail, items;
1155 widget_value *wv, *save_wv, *first_wv, *prev_wv = 0;
1156 int i;
1157
1158 BLOCK_INPUT;
1159
1160 wv = malloc_widget_value ();
1161 wv->name = "menubar";
1162 wv->value = 0;
1163 wv->enabled = 1;
1164 save_wv = first_wv = wv;
1165
1166 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1167 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1168
1169 for (i = 0; i < XVECTOR (items)->size; i += 3)
1170 {
1171 Lisp_Object string;
1172
1173 string = XVECTOR (items)->contents[i + 1];
1174 if (NILP (string))
1175 break;
1176
1177 wv = malloc_widget_value ();
1178 if (prev_wv)
1179 prev_wv->next = wv;
1180 else
1181 save_wv->contents = wv;
1182 wv->name = XSTRING (string)->data;
1183 wv->value = 0;
1184 wv->enabled = 1;
1185 prev_wv = wv;
1186 }
1187
1188 if (menubar_widget)
1189 lw_modify_all_widgets (id, first_wv, False);
1190 else
1191 {
1192 menubar_widget = lw_create_widget ("menubar", "menubar",
1193 id, first_wv,
1194 f->display.x->column_widget,
1195 0, 0,
1196 0, 0);
1197 f->display.x->menubar_widget = menubar_widget;
1198 XtVaSetValues (menubar_widget,
1199 XtNshowGrip, 0,
1200 XtNresizeToPreferred, 1,
1201 XtNallowResize, 1,
1202 0);
1203 }
1204
1205 free_menubar_widget_value_tree (first_wv);
1206
1207 /* Don't update the menubar the first time it is created via x_window. */
1208 if (!first_time)
1209 update_frame_menubar (f);
1210
1211 UNBLOCK_INPUT;
1212 }
1213
1214 void
1215 free_frame_menubar (f)
1216 FRAME_PTR f;
1217 {
1218 Widget menubar_widget;
1219 int id;
1220
1221 menubar_widget = f->display.x->menubar_widget;
1222 id = (int) f;
1223
1224 if (menubar_widget)
1225 {
1226 BLOCK_INPUT;
1227 lw_destroy_all_widgets (id);
1228 UNBLOCK_INPUT;
1229 }
1230 }
1231 /* Called from Fx_create_frame to create the inital menubar of a frame
1232 before it is mapped, so that the window is mapped with the menubar already
1233 there instead of us tacking it on later and thrashing the window after it
1234 is visible. */
1235 void
1236 initialize_frame_menubar (f)
1237 FRAME_PTR f;
1238 {
1239 set_frame_menubar (f, 1);
1240 }
1241 \f
1242 /* Nonzero if position X, Y relative to inside of frame F
1243 is in some other menu bar item. */
1244
1245 static int this_menu_bar_item_beg;
1246 static int this_menu_bar_item_end;
1247
1248 static int
1249 other_menu_bar_item_p (f, x, y)
1250 FRAME_PTR f;
1251 int x, y;
1252 {
1253 return (y >= 0
1254 && y < f->display.x->menubar_widget->core.height
1255 && x >= 0
1256 && x < f->display.x->menubar_widget->core.width
1257 && (x >= this_menu_bar_item_end
1258 || x < this_menu_bar_item_beg));
1259 }
1260
1261 /* Unread a button-press event in the menu bar of frame F
1262 at x position XPOS relative to the inside of the frame. */
1263
1264 static void
1265 unread_menu_bar_button (f, xpos)
1266 FRAME_PTR f;
1267 int xpos;
1268 {
1269 XEvent event;
1270
1271 event.type = ButtonPress;
1272 event.xbutton.display = x_current_display;
1273 event.xbutton.serial = 0;
1274 event.xbutton.send_event = 0;
1275 event.xbutton.time = CurrentTime;
1276 event.xbutton.button = Button1;
1277 event.xbutton.window = XtWindow (f->display.x->menubar_widget);
1278 event.xbutton.x = xpos;
1279 XPutBackEvent (XDISPLAY &event);
1280 }
1281
1282 /* If the mouse has moved to another menu bar item,
1283 return 1 and unread a button press event for that item.
1284 Otherwise return 0. */
1285
1286 static int
1287 check_mouse_other_menu_bar (f)
1288 FRAME_PTR f;
1289 {
1290 FRAME_PTR new_f;
1291 Lisp_Object bar_window;
1292 int part;
1293 Lisp_Object x, y;
1294 unsigned long time;
1295
1296 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
1297
1298 if (f == new_f && other_menu_bar_item_p (f, x, y))
1299 {
1300 unread_menu_bar_button (f, x);
1301 return 1;
1302 }
1303
1304 return 0;
1305 }
1306 #endif /* USE_X_TOOLKIT */
1307 \f
1308 /* xmenu_show actually displays a menu using the panes and items in menu_items
1309 and returns the value selected from it.
1310 There are two versions of xmenu_show, one for Xt and one for Xlib.
1311 Both assume input is blocked by the caller. */
1312
1313 /* F is the frame the menu is for.
1314 X and Y are the frame-relative specified position,
1315 relative to the inside upper left corner of the frame F.
1316 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1317 KEYMAPS is 1 if this menu was specified with keymaps;
1318 in that case, we return a list containing the chosen item's value
1319 and perhaps also the pane's prefix.
1320 TITLE is the specified menu title.
1321 ERROR is a place to store an error message string in case of failure.
1322 (We return nil on failure, but the value doesn't actually matter.) */
1323
1324 #ifdef USE_X_TOOLKIT
1325
1326 extern unsigned int x_mouse_grabbed;
1327 extern Lisp_Object Vmouse_depressed;
1328
1329 static Lisp_Object
1330 xmenu_show (f, x, y, menubarp, keymaps, title, error)
1331 FRAME_PTR f;
1332 int x;
1333 int y;
1334 int menubarp;
1335 int keymaps;
1336 Lisp_Object title;
1337 char **error;
1338 {
1339 int i;
1340 int menu_id;
1341 Widget menu;
1342 XlwMenuWidget menubar = (XlwMenuWidget) f->display.x->menubar_widget;
1343
1344 /* This is the menu bar item (if any) that led to this menu. */
1345 widget_value *menubar_item = 0;
1346
1347 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1348 widget_value **submenu_stack
1349 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1350 Lisp_Object *subprefix_stack
1351 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1352 int submenu_depth = 0;
1353
1354 /* Define a queue to save up for later unreading
1355 all X events that don't pertain to the menu. */
1356 struct event_queue
1357 {
1358 XEvent event;
1359 struct event_queue *next;
1360 };
1361
1362 struct event_queue *queue = NULL;
1363 struct event_queue *queue_tmp;
1364
1365 *error = NULL;
1366
1367 this_menu_bar_item_beg = -1;
1368 this_menu_bar_item_end = -1;
1369
1370 /* Figure out which menu bar item, if any, this menu is for. */
1371 if (menubarp)
1372 {
1373 int xbeg;
1374 int xend = 0;
1375
1376 for (menubar_item = menubar->menu.old_stack[0]->contents;
1377 menubar_item;
1378 menubar_item = menubar_item->next)
1379 {
1380 xbeg = xend;
1381 xend += (string_width (menubar, menubar_item->name)
1382 + 2 * (menubar->menu.horizontal_spacing
1383 + menubar->menu.shadow_thickness));
1384 if (x < xend)
1385 {
1386 x = xbeg + 4;
1387 y = 0;
1388 /* Arrange to show a different menu if we move in the menu bar
1389 to a different item. */
1390 this_menu_bar_item_beg = xbeg;
1391 this_menu_bar_item_end = xend;
1392 break;
1393 }
1394 }
1395 }
1396 if (menubar_item == 0)
1397 menubarp = 0;
1398
1399 /* Offset the coordinates to root-relative. */
1400 x += (f->display.x->widget->core.x
1401 + f->display.x->widget->core.border_width);
1402 y += (f->display.x->widget->core.y
1403 + f->display.x->widget->core.border_width
1404 + f->display.x->menubar_widget->core.height);
1405
1406 /* Create a tree of widget_value objects
1407 representing the panes and their items. */
1408 wv = malloc_widget_value ();
1409 wv->name = "menu";
1410 wv->value = 0;
1411 wv->enabled = 1;
1412 first_wv = wv;
1413
1414 /* Loop over all panes and items, filling in the tree. */
1415 i = 0;
1416 while (i < menu_items_used)
1417 {
1418 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1419 {
1420 submenu_stack[submenu_depth++] = save_wv;
1421 save_wv = prev_wv;
1422 prev_wv = 0;
1423 i++;
1424 }
1425 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1426 {
1427 prev_wv = save_wv;
1428 save_wv = submenu_stack[--submenu_depth];
1429 i++;
1430 }
1431 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1432 && submenu_depth != 0)
1433 i += MENU_ITEMS_PANE_LENGTH;
1434 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1435 {
1436 /* Create a new pane. */
1437 Lisp_Object pane_name, prefix;
1438 char *pane_string;
1439 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1440 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1441 pane_string = (NILP (pane_name)
1442 ? "" : (char *) XSTRING (pane_name)->data);
1443 /* If there is just one top-level pane, put all its items directly
1444 under the top-level menu. */
1445 if (menu_items_n_panes == 1)
1446 pane_string = "";
1447
1448 /* If the pane has a meaningful name,
1449 make the pane a top-level menu item
1450 with its items as a submenu beneath it. */
1451 if (strcmp (pane_string, ""))
1452 {
1453 wv = malloc_widget_value ();
1454 if (save_wv)
1455 save_wv->next = wv;
1456 else
1457 first_wv->contents = wv;
1458 wv->name = pane_string;
1459 if (keymaps && !NILP (prefix))
1460 wv->name++;
1461 wv->value = 0;
1462 wv->enabled = 1;
1463 }
1464 save_wv = wv;
1465 prev_wv = 0;
1466 i += MENU_ITEMS_PANE_LENGTH;
1467 }
1468 else
1469 {
1470 /* Create a new item within current pane. */
1471 Lisp_Object item_name, enable, descrip;
1472 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1473 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1474 descrip
1475 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1476
1477 wv = malloc_widget_value ();
1478 if (prev_wv)
1479 prev_wv->next = wv;
1480 else
1481 save_wv->contents = wv;
1482 wv->name = XSTRING (item_name)->data;
1483 if (!NILP (descrip))
1484 wv->key = XSTRING (descrip)->data;
1485 wv->value = 0;
1486 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1487 wv->enabled = !NILP (enable);
1488 prev_wv = wv;
1489
1490 i += MENU_ITEMS_ITEM_LENGTH;
1491 }
1492 }
1493
1494 /* Actually create the menu. */
1495 menu_id = ++popup_id_tick;
1496 menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv,
1497 f->display.x->widget, 1, 0,
1498 popup_selection_callback, popup_down_callback);
1499 /* Free the widget_value objects we used to specify the contents. */
1500 free_menubar_widget_value_tree (first_wv);
1501
1502 /* No selection has been chosen yet. */
1503 menu_item_selection = 0;
1504
1505 /* If the mouse moves out of the menu before we show the menu,
1506 don't show it at all. */
1507 if (check_mouse_other_menu_bar (f))
1508 {
1509 lw_destroy_all_widgets (menu_id);
1510 return Qnil;
1511 }
1512
1513
1514 /* Highlight the menu bar item (if any) that led to this menu. */
1515 if (menubarp)
1516 {
1517 menubar_item->call_data = (XtPointer) 1;
1518 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
1519 }
1520
1521 /* Display the menu. */
1522 {
1523 XButtonPressedEvent dummy;
1524 XlwMenuWidget mw;
1525
1526 mw = (XlwMenuWidget) ((CompositeWidget)menu)->composite.children[0];
1527
1528 dummy.type = ButtonPress;
1529 dummy.serial = 0;
1530 dummy.send_event = 0;
1531 dummy.display = XtDisplay (menu);
1532 dummy.window = XtWindow (XtParent (menu));
1533 dummy.time = CurrentTime;
1534 dummy.button = 0;
1535 dummy.x_root = x;
1536 dummy.y_root = y;
1537
1538 /* We activate directly the lucid implementation. */
1539 pop_up_menu (mw, &dummy);
1540 }
1541
1542 /* No need to check a second time since this is done in the XEvent loop.
1543 This slows done the execution. */
1544 #if 0
1545 /* Check again whether the mouse has moved to another menu bar item. */
1546 if (check_mouse_other_menu_bar (f))
1547 {
1548 /* The mouse moved into a different menu bar item.
1549 We should bring up that item's menu instead.
1550 First pop down this menu. */
1551 XtUngrabPointer ((Widget)
1552 ((XlwMenuWidget)
1553 ((CompositeWidget)menu)->composite.children[0]),
1554 CurrentTime);
1555 lw_destroy_all_widgets (menu_id);
1556 goto pop_down;
1557 }
1558 #endif
1559
1560 /* Process events that apply to the menu. */
1561 while (1)
1562 {
1563 XEvent event;
1564
1565 XtAppNextEvent (Xt_app_con, &event);
1566 if (event.type == ButtonRelease)
1567 {
1568 XtDispatchEvent (&event);
1569 if (! menubarp)
1570 {
1571 /* Do the work of construct_mouse_click since it can't
1572 be called. Initially, the popup menu has been called
1573 from a ButtonPress in the edit_widget. Then the mouse
1574 has been set to grabbed. Reset it now. */
1575 x_mouse_grabbed &= ~(1 << event.xbutton.button);
1576 if (!x_mouse_grabbed)
1577 Vmouse_depressed = Qnil;
1578 }
1579 break;
1580 }
1581 else if (event.type == Expose)
1582 process_expose_from_menu (event);
1583 else if (event.type == MotionNotify)
1584 {
1585 int event_x = (event.xmotion.x_root
1586 - (f->display.x->widget->core.x
1587 + f->display.x->widget->core.border_width));
1588 int event_y = (event.xmotion.y_root
1589 - (f->display.x->widget->core.y
1590 + f->display.x->widget->core.border_width));
1591
1592 if (other_menu_bar_item_p (f, event_x, event_y))
1593 {
1594 /* The mouse moved into a different menu bar item.
1595 We should bring up that item's menu instead.
1596 First pop down this menu. */
1597 XtUngrabPointer ((Widget)
1598 ((XlwMenuWidget)
1599 ((CompositeWidget)menu)->composite.children[0]),
1600 event.xbutton.time);
1601 lw_destroy_all_widgets (menu_id);
1602
1603 /* Put back an event that will bring up the other item's menu. */
1604 unread_menu_bar_button (f, event_x);
1605 /* Don't let us select anything in this case. */
1606 menu_item_selection = 0;
1607 break;
1608 }
1609 }
1610
1611 XtDispatchEvent (&event);
1612 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1613 {
1614 queue_tmp
1615 = (struct event_queue *) malloc (sizeof (struct event_queue));
1616
1617 if (queue_tmp != NULL)
1618 {
1619 queue_tmp->event = event;
1620 queue_tmp->next = queue;
1621 queue = queue_tmp;
1622 }
1623 }
1624 }
1625
1626 pop_down:
1627 /* Unhighlight the menu bar item (if any) that led to this menu. */
1628 if (menubarp)
1629 {
1630 menubar_item->call_data = (XtPointer) 0;
1631 dispatch_dummy_expose (f->display.x->menubar_widget, x, y);
1632 }
1633
1634 /* fp turned off the following statement and wrote a comment
1635 that it is unnecessary--that the menu has already disappeared.
1636 I observer that is not so. -- rms. */
1637 /* Make sure the menu disappears. */
1638 lw_destroy_all_widgets (menu_id);
1639
1640 /* Unread any events that we got but did not handle. */
1641 while (queue != NULL)
1642 {
1643 queue_tmp = queue;
1644 XPutBackEvent (XDISPLAY &queue_tmp->event);
1645 queue = queue_tmp->next;
1646 free ((char *)queue_tmp);
1647 }
1648
1649 /* Find the selected item, and its pane, to return
1650 the proper value. */
1651 if (menu_item_selection != 0)
1652 {
1653 Lisp_Object prefix;
1654
1655 prefix = Qnil;
1656 i = 0;
1657 while (i < menu_items_used)
1658 {
1659 Lisp_Object entry;
1660
1661 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1662 {
1663 subprefix_stack[submenu_depth++] = prefix;
1664 prefix = entry;
1665 i++;
1666 }
1667 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1668 {
1669 prefix = subprefix_stack[--submenu_depth];
1670 i++;
1671 }
1672 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1673 {
1674 prefix
1675 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1676 i += MENU_ITEMS_PANE_LENGTH;
1677 }
1678 else
1679 {
1680 entry
1681 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1682 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1683 {
1684 if (keymaps != 0)
1685 {
1686 int j;
1687
1688 entry = Fcons (entry, Qnil);
1689 if (!NILP (prefix))
1690 entry = Fcons (prefix, entry);
1691 for (j = submenu_depth - 1; j >= 0; j--)
1692 entry = Fcons (subprefix_stack[j], entry);
1693 }
1694 return entry;
1695 }
1696 i += MENU_ITEMS_ITEM_LENGTH;
1697 }
1698 }
1699 }
1700
1701 return Qnil;
1702 }
1703
1704 static char * button_names [] = {
1705 "button1", "button2", "button3", "button4", "button5",
1706 "button6", "button7", "button8", "button9", "button10" };
1707
1708 static Lisp_Object
1709 xdialog_show (f, menubarp, keymaps, title, error)
1710 FRAME_PTR f;
1711 int menubarp;
1712 int keymaps;
1713 Lisp_Object title;
1714 char **error;
1715 {
1716 int i, nb_buttons=0;
1717 int dialog_id;
1718 Widget menu;
1719 XlwMenuWidget menubar = (XlwMenuWidget) f->display.x->menubar_widget;
1720 char dialog_name[6];
1721
1722 /* This is the menu bar item (if any) that led to this menu. */
1723 widget_value *menubar_item = 0;
1724
1725 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1726
1727 /* Define a queue to save up for later unreading
1728 all X events that don't pertain to the menu. */
1729 struct event_queue
1730 {
1731 XEvent event;
1732 struct event_queue *next;
1733 };
1734
1735 struct event_queue *queue = NULL;
1736 struct event_queue *queue_tmp;
1737
1738 *error = NULL;
1739
1740 if (menu_items_n_panes > 1)
1741 {
1742 *error = "Multiple panes in dialog box";
1743 return Qnil;
1744 }
1745
1746 /* Create a tree of widget_value objects
1747 representing the text label and buttons. */
1748 {
1749 Lisp_Object pane_name, prefix;
1750 char *pane_string;
1751 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1752 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1753 pane_string = (NILP (pane_name)
1754 ? "" : (char *) XSTRING (pane_name)->data);
1755 prev_wv = malloc_widget_value ();
1756 prev_wv->value = pane_string;
1757 if (keymaps && !NILP (prefix))
1758 prev_wv->name++;
1759 prev_wv->enabled = 1;
1760 prev_wv->name = "message";
1761 first_wv = prev_wv;
1762
1763 /* Loop over all panes and items, filling in the tree. */
1764 i = MENU_ITEMS_PANE_LENGTH;
1765 while (i < menu_items_used)
1766 {
1767
1768 /* Create a new item within current pane. */
1769 Lisp_Object item_name, enable, descrip;
1770 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1771 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1772 descrip
1773 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1774
1775 if (NILP (item_name))
1776 {
1777 free_menubar_widget_value_tree (first_wv);
1778 *error = "Submenu in dialog items";
1779 return Qnil;
1780 }
1781 if (nb_buttons >= 10)
1782 {
1783 free_menubar_widget_value_tree (first_wv);
1784 *error = "Too many dialog items";
1785 return Qnil;
1786 }
1787
1788 wv = malloc_widget_value ();
1789 prev_wv->next = wv;
1790 wv->name = (char *) button_names[nb_buttons];
1791 if (!NILP (descrip))
1792 wv->key = XSTRING (descrip)->data;
1793 wv->value = XSTRING (item_name)->data;
1794 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1795 wv->enabled = !NILP (enable);
1796 prev_wv = wv;
1797
1798 nb_buttons++;
1799 i += MENU_ITEMS_ITEM_LENGTH;
1800 }
1801
1802 wv = malloc_widget_value ();
1803 wv->name = dialog_name;
1804
1805 /* Dialog boxes use a really stupid name encoding
1806 which specifies how many buttons to use
1807 and how many buttons are on the right.
1808 The Q means something also. */
1809 dialog_name[0] = 'Q';
1810 dialog_name[1] = '0' + nb_buttons;
1811 dialog_name[2] = 'B';
1812 dialog_name[3] = 'R';
1813 dialog_name[4] = '0' + nb_buttons / 2;
1814 dialog_name[5] = 0;
1815 wv->contents = first_wv;
1816 first_wv = wv;
1817
1818 }
1819
1820 /* Actually create the dialog. */
1821 dialog_id = ++popup_id_tick;
1822 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1823 f->display.x->widget, 1, 0,
1824 dialog_selection_callback, 0);
1825 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1826 lw_modify_all_widgets (dialog_id, first_wv, True);
1827 #endif
1828 lw_modify_all_widgets (dialog_id, first_wv->contents->next, True);
1829 /* Free the widget_value objects we used to specify the contents. */
1830 free_menubar_widget_value_tree (first_wv);
1831
1832 /* No selection has been chosen yet. */
1833 menu_item_selection = 0;
1834
1835 /* Display the menu. */
1836 lw_pop_up_all_widgets (dialog_id);
1837
1838 /* Process events that apply to the menu. */
1839 while (1)
1840 {
1841 XEvent event;
1842
1843 XtAppNextEvent (Xt_app_con, &event);
1844 if (event.type == ButtonRelease)
1845 {
1846 XtDispatchEvent (&event);
1847 break;
1848 }
1849 else if (event.type == Expose)
1850 process_expose_from_menu (event);
1851 XtDispatchEvent (&event);
1852 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1853 {
1854 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1855
1856 if (queue_tmp != NULL)
1857 {
1858 queue_tmp->event = event;
1859 queue_tmp->next = queue;
1860 queue = queue_tmp;
1861 }
1862 }
1863 }
1864 pop_down:
1865
1866 /* Unread any events that we got but did not handle. */
1867 while (queue != NULL)
1868 {
1869 queue_tmp = queue;
1870 XPutBackEvent (XDISPLAY &queue_tmp->event);
1871 queue = queue_tmp->next;
1872 free ((char *)queue_tmp);
1873 }
1874
1875 /* Find the selected item, and its pane, to return
1876 the proper value. */
1877 if (menu_item_selection != 0)
1878 {
1879 Lisp_Object prefix;
1880
1881 prefix = Qnil;
1882 i = 0;
1883 while (i < menu_items_used)
1884 {
1885 Lisp_Object entry;
1886
1887 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1888 {
1889 prefix
1890 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1891 i += MENU_ITEMS_PANE_LENGTH;
1892 }
1893 else
1894 {
1895 entry
1896 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1897 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1898 {
1899 if (keymaps != 0)
1900 {
1901 entry = Fcons (entry, Qnil);
1902 if (!NILP (prefix))
1903 entry = Fcons (prefix, entry);
1904 }
1905 return entry;
1906 }
1907 i += MENU_ITEMS_ITEM_LENGTH;
1908 }
1909 }
1910 }
1911
1912 return Qnil;
1913 }
1914 #else /* not USE_X_TOOLKIT */
1915
1916 static Lisp_Object
1917 xmenu_show (f, x, y, menubarp, keymaps, title, error)
1918 FRAME_PTR f;
1919 int x, y;
1920 int keymaps;
1921 int menubarp;
1922 Lisp_Object title;
1923 char **error;
1924 {
1925 Window root;
1926 XMenu *menu;
1927 int pane, selidx, lpane, status;
1928 Lisp_Object entry, pane_prefix;
1929 char *datap;
1930 int ulx, uly, width, height;
1931 int dispwidth, dispheight;
1932 int i;
1933 int dummy_int;
1934 unsigned int dummy_uint;
1935
1936 *error = 0;
1937 if (menu_items_n_panes == 0)
1938 return Qnil;
1939
1940 /* Figure out which root window F is on. */
1941 XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root,
1942 &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
1943 &dummy_uint, &dummy_uint);
1944
1945 /* Make the menu on that window. */
1946 menu = XMenuCreate (XDISPLAY root, "emacs");
1947 if (menu == NULL)
1948 {
1949 *error = "Can't create menu";
1950 return Qnil;
1951 }
1952
1953 /* Adjust coordinates to relative to the outer (window manager) window. */
1954 #ifdef HAVE_X11
1955 {
1956 Window child;
1957 int win_x = 0, win_y = 0;
1958
1959 /* Find the position of the outside upper-left corner of
1960 the inner window, with respect to the outer window. */
1961 if (f->display.x->parent_desc != ROOT_WINDOW)
1962 {
1963 BLOCK_INPUT;
1964 XTranslateCoordinates (x_current_display,
1965
1966 /* From-window, to-window. */
1967 f->display.x->window_desc,
1968 f->display.x->parent_desc,
1969
1970 /* From-position, to-position. */
1971 0, 0, &win_x, &win_y,
1972
1973 /* Child of window. */
1974 &child);
1975 UNBLOCK_INPUT;
1976 x += win_x;
1977 y += win_y;
1978 }
1979 }
1980 #endif /* HAVE_X11 */
1981
1982 /* Adjust coordinates to be root-window-relative. */
1983 x += f->display.x->left_pos;
1984 y += f->display.x->top_pos;
1985
1986 /* Create all the necessary panes and their items. */
1987 i = 0;
1988 while (i < menu_items_used)
1989 {
1990 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1991 {
1992 /* Create a new pane. */
1993 Lisp_Object pane_name, prefix;
1994 char *pane_string;
1995
1996 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1997 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1998 pane_string = (NILP (pane_name)
1999 ? "" : (char *) XSTRING (pane_name)->data);
2000 if (keymaps && !NILP (prefix))
2001 pane_string++;
2002
2003 lpane = XMenuAddPane (XDISPLAY menu, pane_string, TRUE);
2004 if (lpane == XM_FAILURE)
2005 {
2006 XMenuDestroy (XDISPLAY menu);
2007 *error = "Can't create pane";
2008 return Qnil;
2009 }
2010 i += MENU_ITEMS_PANE_LENGTH;
2011 }
2012 else
2013 {
2014 /* Create a new item within current pane. */
2015 Lisp_Object item_name, enable, descrip;
2016
2017 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2018 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2019 descrip
2020 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2021 if (!NILP (descrip))
2022 item_name = concat2 (item_name, descrip);
2023
2024 if (XMenuAddSelection (XDISPLAY menu, lpane, 0,
2025 XSTRING (item_name)->data,
2026 !NILP (enable))
2027 == XM_FAILURE)
2028 {
2029 XMenuDestroy (XDISPLAY menu);
2030 *error = "Can't add selection to menu";
2031 return Qnil;
2032 }
2033 i += MENU_ITEMS_ITEM_LENGTH;
2034 }
2035 }
2036
2037 /* All set and ready to fly. */
2038 XMenuRecompute (XDISPLAY menu);
2039 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
2040 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
2041 x = min (x, dispwidth);
2042 y = min (y, dispheight);
2043 x = max (x, 1);
2044 y = max (y, 1);
2045 XMenuLocate (XDISPLAY menu, 0, 0, x, y,
2046 &ulx, &uly, &width, &height);
2047 if (ulx+width > dispwidth)
2048 {
2049 x -= (ulx + width) - dispwidth;
2050 ulx = dispwidth - width;
2051 }
2052 if (uly+height > dispheight)
2053 {
2054 y -= (uly + height) - dispheight;
2055 uly = dispheight - height;
2056 }
2057 if (ulx < 0) x -= ulx;
2058 if (uly < 0) y -= uly;
2059
2060 XMenuSetAEQ (menu, TRUE);
2061 XMenuSetFreeze (menu, TRUE);
2062 pane = selidx = 0;
2063
2064 status = XMenuActivate (XDISPLAY menu, &pane, &selidx,
2065 x, y, ButtonReleaseMask, &datap);
2066 switch (status)
2067 {
2068 case XM_SUCCESS:
2069 #ifdef XDEBUG
2070 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
2071 #endif
2072
2073 /* Find the item number SELIDX in pane number PANE. */
2074 i = 0;
2075 while (i < menu_items_used)
2076 {
2077 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2078 {
2079 if (pane == 0)
2080 pane_prefix
2081 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2082 pane--;
2083 i += MENU_ITEMS_PANE_LENGTH;
2084 }
2085 else
2086 {
2087 if (pane == -1)
2088 {
2089 if (selidx == 0)
2090 {
2091 entry
2092 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2093 if (keymaps != 0)
2094 {
2095 entry = Fcons (entry, Qnil);
2096 if (!NILP (pane_prefix))
2097 entry = Fcons (pane_prefix, entry);
2098 }
2099 break;
2100 }
2101 selidx--;
2102 }
2103 i += MENU_ITEMS_ITEM_LENGTH;
2104 }
2105 }
2106 break;
2107
2108 case XM_FAILURE:
2109 XMenuDestroy (XDISPLAY menu);
2110 *error = "Can't activate menu";
2111 case XM_IA_SELECT:
2112 case XM_NO_SELECT:
2113 entry = Qnil;
2114 break;
2115 }
2116 XMenuDestroy (XDISPLAY menu);
2117 return entry;
2118 }
2119 #endif /* not USE_X_TOOLKIT */
2120 \f
2121 syms_of_xmenu ()
2122 {
2123 staticpro (&menu_items);
2124 menu_items = Qnil;
2125
2126 popup_id_tick = (1<<16);
2127 defsubr (&Sx_popup_menu);
2128 defsubr (&Sx_popup_dialog);
2129 }