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