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