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