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