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