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