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