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