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