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