Use "ASET (a, i, v)" rather than "AREF (a, i) = v".
[bpt/emacs.git] / src / menu.c
CommitLineData
279a1d4b 1/* Platform-independent code for terminal communications.
95df8112 2
acaf905b 3Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2012
95df8112 4 Free Software Foundation, Inc.
279a1d4b
CY
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software: you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation, either version 3 of the License, or
11(at your option) any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21#include <config.h>
22#include <stdio.h>
d7306fe6 23#include <setjmp.h>
3c24731f 24#include <limits.h> /* for INT_MAX */
279a1d4b
CY
25
26#include "lisp.h"
27#include "keyboard.h"
28#include "keymap.h"
29#include "frame.h"
ef7417fd 30#include "window.h"
279a1d4b
CY
31#include "termhooks.h"
32#include "blockinput.h"
33#include "dispextern.h"
34
35#ifdef USE_X_TOOLKIT
36#include "../lwlib/lwlib.h"
37#endif
38
a4240420
AS
39#ifdef HAVE_X_WINDOWS
40#include "xterm.h"
41#endif
42
edfda783
AR
43#ifdef HAVE_NS
44#include "nsterm.h"
45#endif
46
279a1d4b
CY
47#ifdef USE_GTK
48#include "gtkutil.h"
49#endif
50
51#ifdef HAVE_NTGUI
a8495745 52#include "w32term.h"
279a1d4b 53
279a1d4b 54extern AppendMenuW_Proc unicode_append_menu;
04e452cb 55extern HMENU current_popup_menu;
279a1d4b
CY
56
57#endif /* HAVE_NTGUI */
58
e7c9048f 59#include "menu.h"
279a1d4b
CY
60
61/* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
62#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
63#define HAVE_BOXES 1
64#endif
65
279a1d4b
CY
66Lisp_Object menu_items;
67
68/* If non-nil, means that the global vars defined here are already in use.
69 Used to detect cases where we try to re-enter this non-reentrant code. */
4475bec4
PE
70#if ! (defined USE_GTK || defined USE_MOTIF)
71static
72#endif
279a1d4b
CY
73Lisp_Object menu_items_inuse;
74
75/* Number of slots currently allocated in menu_items. */
76int menu_items_allocated;
77
78/* This is the index in menu_items of the first empty slot. */
79int menu_items_used;
80
81/* The number of panes currently recorded in menu_items,
82 excluding those within submenus. */
83int menu_items_n_panes;
84
85/* Current depth within submenus. */
86static int menu_items_submenu_depth;
87
88void
971de7fb 89init_menu_items (void)
279a1d4b
CY
90{
91 if (!NILP (menu_items_inuse))
92 error ("Trying to use a menu from within a menu-entry");
93
94 if (NILP (menu_items))
95 {
96 menu_items_allocated = 60;
97 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
98 }
99
100 menu_items_inuse = Qt;
101 menu_items_used = 0;
102 menu_items_n_panes = 0;
103 menu_items_submenu_depth = 0;
104}
105
106/* Call at the end of generating the data in menu_items. */
107
108void
971de7fb 109finish_menu_items (void)
279a1d4b
CY
110{
111}
112
113Lisp_Object
971de7fb 114unuse_menu_items (Lisp_Object dummy)
279a1d4b
CY
115{
116 return menu_items_inuse = Qnil;
117}
118
119/* Call when finished using the data for the current menu
120 in menu_items. */
121
122void
971de7fb 123discard_menu_items (void)
279a1d4b
CY
124{
125 /* Free the structure if it is especially large.
126 Otherwise, hold on to it, to save time. */
127 if (menu_items_allocated > 200)
128 {
129 menu_items = Qnil;
130 menu_items_allocated = 0;
131 }
a54e2c05 132 eassert (NILP (menu_items_inuse));
279a1d4b
CY
133}
134
94da8397 135#ifdef HAVE_NS
ef7417fd
SM
136static Lisp_Object
137cleanup_popup_menu (Lisp_Object arg)
138{
139 discard_menu_items ();
140 return Qnil;
141}
94da8397 142#endif
ef7417fd 143
279a1d4b
CY
144/* This undoes save_menu_items, and it is called by the specpdl unwind
145 mechanism. */
146
147static Lisp_Object
971de7fb 148restore_menu_items (Lisp_Object saved)
279a1d4b
CY
149{
150 menu_items = XCAR (saved);
151 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
152 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
153 saved = XCDR (saved);
154 menu_items_used = XINT (XCAR (saved));
155 saved = XCDR (saved);
156 menu_items_n_panes = XINT (XCAR (saved));
157 saved = XCDR (saved);
158 menu_items_submenu_depth = XINT (XCAR (saved));
159 return Qnil;
160}
161
162/* Push the whole state of menu_items processing onto the specpdl.
163 It will be restored when the specpdl is unwound. */
164
165void
971de7fb 166save_menu_items (void)
279a1d4b
CY
167{
168 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
169 make_number (menu_items_used),
170 make_number (menu_items_n_panes),
171 make_number (menu_items_submenu_depth));
172 record_unwind_protect (restore_menu_items, saved);
173 menu_items_inuse = Qnil;
174 menu_items = Qnil;
175}
176
177\f
d311d28c 178/* Ensure that there is room for ITEMS items in the menu_items vector. */
279a1d4b
CY
179
180static void
d311d28c 181ensure_menu_items (int items)
279a1d4b 182{
d311d28c
PE
183 int incr = items - (menu_items_allocated - menu_items_used);
184 if (0 < incr)
185 {
186 menu_items = larger_vector (menu_items, incr, INT_MAX);
187 menu_items_allocated = ASIZE (menu_items);
188 }
279a1d4b
CY
189}
190
60d9e1db
PE
191#if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
192 || defined HAVE_NTGUI)
193
279a1d4b
CY
194/* Begin a submenu. */
195
196static void
971de7fb 197push_submenu_start (void)
279a1d4b 198{
d311d28c 199 ensure_menu_items (1);
fb7da12e
AS
200 ASET (menu_items, menu_items_used, Qnil);
201 menu_items_used++;
279a1d4b
CY
202 menu_items_submenu_depth++;
203}
204
205/* End a submenu. */
206
207static void
971de7fb 208push_submenu_end (void)
279a1d4b 209{
d311d28c 210 ensure_menu_items (1);
fb7da12e
AS
211 ASET (menu_items, menu_items_used, Qlambda);
212 menu_items_used++;
279a1d4b
CY
213 menu_items_submenu_depth--;
214}
215
60d9e1db
PE
216#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
217
279a1d4b
CY
218/* Indicate boundary between left and right. */
219
220static void
971de7fb 221push_left_right_boundary (void)
279a1d4b 222{
d311d28c 223 ensure_menu_items (1);
fb7da12e
AS
224 ASET (menu_items, menu_items_used, Qquote);
225 menu_items_used++;
279a1d4b
CY
226}
227
228/* Start a new menu pane in menu_items.
229 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
230
593c843c 231static void
971de7fb 232push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
279a1d4b 233{
d311d28c 234 ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
279a1d4b
CY
235 if (menu_items_submenu_depth == 0)
236 menu_items_n_panes++;
fb7da12e
AS
237 ASET (menu_items, menu_items_used, Qt);
238 menu_items_used++;
239 ASET (menu_items, menu_items_used, name);
240 menu_items_used++;
241 ASET (menu_items, menu_items_used, prefix_vec);
242 menu_items_used++;
279a1d4b
CY
243}
244
245/* Push one menu item into the current pane. NAME is the string to
246 display. ENABLE if non-nil means this item can be selected. KEY
247 is the key generated by choosing this item, or nil if this item
248 doesn't really have a definition. DEF is the definition of this
249 item. EQUIV is the textual description of the keyboard equivalent
250 for this item (or nil if none). TYPE is the type of this menu
251 item, one of nil, `toggle' or `radio'. */
252
593c843c 253static void
971de7fb 254push_menu_item (Lisp_Object name, Lisp_Object enable, Lisp_Object key, Lisp_Object def, Lisp_Object equiv, Lisp_Object type, Lisp_Object selected, Lisp_Object help)
279a1d4b 255{
d311d28c 256 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
279a1d4b 257
b7c7a4d1
SM
258 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
259 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
260 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
261 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
262 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
263 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
264 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
265 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
266
267 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
279a1d4b
CY
268}
269
270/* Args passed between single_keymap_panes and single_menu_item. */
271struct skp
272 {
273 Lisp_Object pending_maps;
ef7417fd 274 int maxdepth;
279a1d4b
CY
275 int notbuttons;
276 };
277
f57e2426
J
278static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
279 void *);
279a1d4b
CY
280
281/* This is a recursive subroutine of keymap_panes.
282 It handles one keymap, KEYMAP.
283 The other arguments are passed along
284 or point to local variables of the previous function.
279a1d4b
CY
285
286 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
287
593c843c 288static void
ef7417fd
SM
289single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
290 Lisp_Object prefix, int maxdepth)
279a1d4b
CY
291{
292 struct skp skp;
293 struct gcpro gcpro1;
294
295 skp.pending_maps = Qnil;
296 skp.maxdepth = maxdepth;
279a1d4b
CY
297 skp.notbuttons = 0;
298
299 if (maxdepth <= 0)
300 return;
301
302 push_menu_pane (pane_name, prefix);
303
304#ifndef HAVE_BOXES
305 /* Remember index for first item in this pane so we can go back and
306 add a prefix when (if) we see the first button. After that, notbuttons
307 is set to 0, to mark that we have seen a button and all non button
308 items need a prefix. */
309 skp.notbuttons = menu_items_used;
310#endif
311
312 GCPRO1 (skp.pending_maps);
313 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
314 UNGCPRO;
315
316 /* Process now any submenus which want to be panes at this level. */
317 while (CONSP (skp.pending_maps))
318 {
319 Lisp_Object elt, eltcdr, string;
320 elt = XCAR (skp.pending_maps);
321 eltcdr = XCDR (elt);
322 string = XCAR (eltcdr);
323 /* We no longer discard the @ from the beginning of the string here.
324 Instead, we do this in *menu_show. */
ef7417fd 325 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
279a1d4b
CY
326 skp.pending_maps = XCDR (skp.pending_maps);
327 }
328}
329
330/* This is a subroutine of single_keymap_panes that handles one
331 keymap entry.
332 KEY is a key in a keymap and ITEM is its binding.
333 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
334 separate panes.
279a1d4b
CY
335 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
336
337static void
971de7fb 338single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
279a1d4b
CY
339{
340 Lisp_Object map, item_string, enabled;
341 struct gcpro gcpro1, gcpro2;
342 int res;
343 struct skp *skp = skp_v;
344
345 /* Parse the menu item and leave the result in item_properties. */
346 GCPRO2 (key, item);
ef7417fd 347 res = parse_menu_item (item, 0);
279a1d4b
CY
348 UNGCPRO;
349 if (!res)
350 return; /* Not a menu item. */
351
28be1ada 352 map = AREF (item_properties, ITEM_PROPERTY_MAP);
279a1d4b 353
28be1ada
DA
354 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
355 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
279a1d4b
CY
356
357 if (!NILP (map) && SREF (item_string, 0) == '@')
358 {
359 if (!NILP (enabled))
360 /* An enabled separate pane. Remember this to handle it later. */
361 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
362 skp->pending_maps);
363 return;
364 }
365
5e617bc2 366#if defined (HAVE_X_WINDOWS) || defined (MSDOS)
279a1d4b
CY
367#ifndef HAVE_BOXES
368 /* Simulate radio buttons and toggle boxes by putting a prefix in
369 front of them. */
370 {
371 Lisp_Object prefix = Qnil;
28be1ada 372 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
279a1d4b
CY
373 if (!NILP (type))
374 {
375 Lisp_Object selected
28be1ada 376 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
279a1d4b
CY
377
378 if (skp->notbuttons)
379 /* The first button. Line up previous items in this menu. */
380 {
60d9e1db 381 int idx = skp->notbuttons; /* Index for first item this menu. */
279a1d4b
CY
382 int submenu = 0;
383 Lisp_Object tem;
60d9e1db 384 while (idx < menu_items_used)
279a1d4b
CY
385 {
386 tem
28be1ada 387 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
279a1d4b
CY
388 if (NILP (tem))
389 {
60d9e1db 390 idx++;
279a1d4b
CY
391 submenu++; /* Skip sub menu. */
392 }
393 else if (EQ (tem, Qlambda))
394 {
60d9e1db 395 idx++;
279a1d4b
CY
396 submenu--; /* End sub menu. */
397 }
398 else if (EQ (tem, Qt))
60d9e1db 399 idx += 3; /* Skip new pane marker. */
279a1d4b 400 else if (EQ (tem, Qquote))
60d9e1db 401 idx++; /* Skip a left, right divider. */
279a1d4b
CY
402 else
403 {
404 if (!submenu && SREF (tem, 0) != '\0'
405 && SREF (tem, 0) != '-')
28be1ada
DA
406 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
407 concat2 (build_string (" "), tem));
60d9e1db 408 idx += MENU_ITEMS_ITEM_LENGTH;
279a1d4b
CY
409 }
410 }
411 skp->notbuttons = 0;
412 }
413
414 /* Calculate prefix, if any, for this item. */
415 if (EQ (type, QCtoggle))
416 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
417 else if (EQ (type, QCradio))
418 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
419 }
420 /* Not a button. If we have earlier buttons, then we need a prefix. */
421 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
422 && SREF (item_string, 0) != '-')
423 prefix = build_string (" ");
424
425 if (!NILP (prefix))
426 item_string = concat2 (prefix, item_string);
427 }
428#endif /* not HAVE_BOXES */
429
430#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
431 if (!NILP (map))
432 /* Indicate visually that this is a submenu. */
433 item_string = concat2 (item_string, build_string (" >"));
434#endif
435
dda86321 436#endif /* HAVE_X_WINDOWS || MSDOS */
279a1d4b
CY
437
438 push_menu_item (item_string, enabled, key,
28be1ada
DA
439 AREF (item_properties, ITEM_PROPERTY_DEF),
440 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
441 AREF (item_properties, ITEM_PROPERTY_TYPE),
442 AREF (item_properties, ITEM_PROPERTY_SELECTED),
443 AREF (item_properties, ITEM_PROPERTY_HELP));
279a1d4b 444
edfda783 445#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
279a1d4b
CY
446 /* Display a submenu using the toolkit. */
447 if (! (NILP (map) || NILP (enabled)))
448 {
449 push_submenu_start ();
ef7417fd 450 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
279a1d4b
CY
451 push_submenu_end ();
452 }
453#endif
454}
455
456/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
ef7417fd 457 and generate menu panes for them in menu_items. */
279a1d4b 458
ef7417fd 459static void
d311d28c 460keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
279a1d4b 461{
d311d28c 462 ptrdiff_t mapno;
279a1d4b
CY
463
464 init_menu_items ();
465
466 /* Loop over the given keymaps, making a pane for each map.
467 But don't make a pane that is empty--ignore that map instead.
468 P is the number of panes we have made so far. */
469 for (mapno = 0; mapno < nmaps; mapno++)
470 single_keymap_panes (keymaps[mapno],
ef7417fd 471 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
279a1d4b
CY
472
473 finish_menu_items ();
474}
475
476
477/* Push the items in a single pane defined by the alist PANE. */
478static void
971de7fb 479list_of_items (Lisp_Object pane)
279a1d4b
CY
480{
481 Lisp_Object tail, item, item1;
482
483 for (tail = pane; CONSP (tail); tail = XCDR (tail))
484 {
485 item = XCAR (tail);
486 if (STRINGP (item))
487 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
488 Qnil, Qnil, Qnil, Qnil);
489 else if (CONSP (item))
490 {
491 item1 = XCAR (item);
492 CHECK_STRING (item1);
493 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
494 Qt, Qnil, Qnil, Qnil, Qnil);
495 }
496 else
497 push_left_right_boundary ();
498
499 }
500}
501
502/* Push all the panes and items of a menu described by the
503 alist-of-alists MENU.
504 This handles old-fashioned calls to x-popup-menu. */
505void
971de7fb 506list_of_panes (Lisp_Object menu)
279a1d4b
CY
507{
508 Lisp_Object tail;
509
510 init_menu_items ();
511
512 for (tail = menu; CONSP (tail); tail = XCDR (tail))
513 {
514 Lisp_Object elt, pane_name, pane_data;
515 elt = XCAR (tail);
516 pane_name = Fcar (elt);
517 CHECK_STRING (pane_name);
518 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
519 pane_data = Fcdr (elt);
520 CHECK_CONS (pane_data);
521 list_of_items (pane_data);
522 }
523
524 finish_menu_items ();
525}
526
527/* Set up data in menu_items for a menu bar item
528 whose event type is ITEM_KEY (with string ITEM_NAME)
529 and whose contents come from the list of keymaps MAPS. */
530int
971de7fb 531parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
279a1d4b
CY
532{
533 Lisp_Object length;
d311d28c 534 EMACS_INT len;
279a1d4b 535 Lisp_Object *mapvec;
d311d28c 536 ptrdiff_t i;
279a1d4b 537 int top_level_items = 0;
d311d28c 538 USE_SAFE_ALLOCA;
279a1d4b
CY
539
540 length = Flength (maps);
541 len = XINT (length);
542
543 /* Convert the list MAPS into a vector MAPVEC. */
d311d28c 544 SAFE_ALLOCA_LISP (mapvec, len);
279a1d4b
CY
545 for (i = 0; i < len; i++)
546 {
547 mapvec[i] = Fcar (maps);
548 maps = Fcdr (maps);
549 }
550
551 /* Loop over the given keymaps, making a pane for each map.
552 But don't make a pane that is empty--ignore that map instead. */
553 for (i = 0; i < len; i++)
554 {
555 if (!KEYMAPP (mapvec[i]))
556 {
557 /* Here we have a command at top level in the menu bar
558 as opposed to a submenu. */
559 top_level_items = 1;
560 push_menu_pane (Qnil, Qnil);
561 push_menu_item (item_name, Qt, item_key, mapvec[i],
562 Qnil, Qnil, Qnil, Qnil);
563 }
564 else
565 {
566 Lisp_Object prompt;
567 prompt = Fkeymap_prompt (mapvec[i]);
568 single_keymap_panes (mapvec[i],
569 !NILP (prompt) ? prompt : item_name,
ef7417fd 570 item_key, 10);
279a1d4b
CY
571 }
572 }
573
d311d28c 574 SAFE_FREE ();
279a1d4b
CY
575 return top_level_items;
576}
577
578\f
edfda783 579#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
279a1d4b
CY
580
581/* Allocate a widget_value, blocking input. */
582
583widget_value *
971de7fb 584xmalloc_widget_value (void)
279a1d4b
CY
585{
586 widget_value *value;
587
588 BLOCK_INPUT;
589 value = malloc_widget_value ();
590 UNBLOCK_INPUT;
591
592 return value;
593}
594
595/* This recursively calls free_widget_value on the tree of widgets.
596 It must free all data that was malloc'ed for these widget_values.
597 In Emacs, many slots are pointers into the data of Lisp_Strings, and
598 must be left alone. */
599
600void
971de7fb 601free_menubar_widget_value_tree (widget_value *wv)
279a1d4b
CY
602{
603 if (! wv) return;
604
605 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
606
607 if (wv->contents && (wv->contents != (widget_value*)1))
608 {
609 free_menubar_widget_value_tree (wv->contents);
610 wv->contents = (widget_value *) 0xDEADBEEF;
611 }
612 if (wv->next)
613 {
614 free_menubar_widget_value_tree (wv->next);
615 wv->next = (widget_value *) 0xDEADBEEF;
616 }
617 BLOCK_INPUT;
618 free_widget_value (wv);
619 UNBLOCK_INPUT;
620}
621
622/* Create a tree of widget_value objects
623 representing the panes and items
624 in menu_items starting at index START, up to index END. */
625
626widget_value *
971de7fb 627digest_single_submenu (int start, int end, int top_level_items)
279a1d4b
CY
628{
629 widget_value *wv, *prev_wv, *save_wv, *first_wv;
630 int i;
631 int submenu_depth = 0;
632 widget_value **submenu_stack;
633 int panes_seen = 0;
634
38182d90 635 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
279a1d4b
CY
636 wv = xmalloc_widget_value ();
637 wv->name = "menu";
638 wv->value = 0;
639 wv->enabled = 1;
640 wv->button_type = BUTTON_TYPE_NONE;
641 wv->help = Qnil;
642 first_wv = wv;
643 save_wv = 0;
644 prev_wv = 0;
645
646 /* Loop over all panes and items made by the preceding call
647 to parse_single_submenu and construct a tree of widget_value objects.
648 Ignore the panes and items used by previous calls to
649 digest_single_submenu, even though those are also in menu_items. */
650 i = start;
651 while (i < end)
652 {
28be1ada 653 if (EQ (AREF (menu_items, i), Qnil))
279a1d4b
CY
654 {
655 submenu_stack[submenu_depth++] = save_wv;
656 save_wv = prev_wv;
657 prev_wv = 0;
658 i++;
659 }
28be1ada 660 else if (EQ (AREF (menu_items, i), Qlambda))
279a1d4b
CY
661 {
662 prev_wv = save_wv;
663 save_wv = submenu_stack[--submenu_depth];
664 i++;
665 }
28be1ada 666 else if (EQ (AREF (menu_items, i), Qt)
279a1d4b
CY
667 && submenu_depth != 0)
668 i += MENU_ITEMS_PANE_LENGTH;
669 /* Ignore a nil in the item list.
670 It's meaningful only for dialog boxes. */
28be1ada 671 else if (EQ (AREF (menu_items, i), Qquote))
279a1d4b 672 i += 1;
28be1ada 673 else if (EQ (AREF (menu_items, i), Qt))
279a1d4b
CY
674 {
675 /* Create a new pane. */
b01a1c29 676 Lisp_Object pane_name;
675e2c69 677 const char *pane_string;
279a1d4b
CY
678
679 panes_seen++;
680
28be1ada 681 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
279a1d4b
CY
682
683#ifdef HAVE_NTGUI
684 if (STRINGP (pane_name))
685 {
686 if (unicode_append_menu)
687 /* Encode as UTF-8 for now. */
688 pane_name = ENCODE_UTF_8 (pane_name);
689 else if (STRING_MULTIBYTE (pane_name))
690 pane_name = ENCODE_SYSTEM (pane_name);
691
692 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
693 }
99852628
JD
694#elif defined (USE_LUCID) && defined (HAVE_XFT)
695 if (STRINGP (pane_name))
696 {
697 pane_name = ENCODE_UTF_8 (pane_name);
698 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
699 }
279a1d4b
CY
700#elif !defined (HAVE_MULTILINGUAL_MENU)
701 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
702 {
703 pane_name = ENCODE_MENU_STRING (pane_name);
704 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
705 }
706#endif
707
708 pane_string = (NILP (pane_name)
51b59d79 709 ? "" : SSDATA (pane_name));
279a1d4b
CY
710 /* If there is just one top-level pane, put all its items directly
711 under the top-level menu. */
712 if (menu_items_n_panes == 1)
713 pane_string = "";
714
715 /* If the pane has a meaningful name,
716 make the pane a top-level menu item
717 with its items as a submenu beneath it. */
718 if (strcmp (pane_string, ""))
719 {
720 wv = xmalloc_widget_value ();
721 if (save_wv)
722 save_wv->next = wv;
723 else
724 first_wv->contents = wv;
725 wv->lname = pane_name;
726 /* Set value to 1 so update_submenu_strings can handle '@' */
727 wv->value = (char *)1;
728 wv->enabled = 1;
729 wv->button_type = BUTTON_TYPE_NONE;
730 wv->help = Qnil;
731 save_wv = wv;
732 }
733 else
734 save_wv = first_wv;
735
736 prev_wv = 0;
737 i += MENU_ITEMS_PANE_LENGTH;
738 }
739 else
740 {
741 /* Create a new item within current pane. */
742 Lisp_Object item_name, enable, descrip, def, type, selected;
743 Lisp_Object help;
744
745 /* All items should be contained in panes. */
746 if (panes_seen == 0)
747 abort ();
748
749 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
750 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
751 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
752 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
753 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
754 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
755 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
756
757#ifdef HAVE_NTGUI
758 if (STRINGP (item_name))
759 {
760 if (unicode_append_menu)
761 item_name = ENCODE_UTF_8 (item_name);
762 else if (STRING_MULTIBYTE (item_name))
763 item_name = ENCODE_SYSTEM (item_name);
764
765 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
766 }
767
768 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
769 {
770 descrip = ENCODE_SYSTEM (descrip);
771 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
772 }
99852628
JD
773#elif USE_LUCID
774 if (STRINGP (item_name))
775 {
776 item_name = ENCODE_UTF_8 (item_name);
777 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
778 }
779
780 if (STRINGP (descrip))
781 {
782 descrip = ENCODE_UTF_8 (descrip);
783 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
784 }
279a1d4b
CY
785#elif !defined (HAVE_MULTILINGUAL_MENU)
786 if (STRING_MULTIBYTE (item_name))
787 {
788 item_name = ENCODE_MENU_STRING (item_name);
789 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
790 }
791
792 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
793 {
794 descrip = ENCODE_MENU_STRING (descrip);
795 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
796 }
797#endif
798
799 wv = xmalloc_widget_value ();
800 if (prev_wv)
801 prev_wv->next = wv;
802 else
803 save_wv->contents = wv;
804
805 wv->lname = item_name;
806 if (!NILP (descrip))
807 wv->lkey = descrip;
808 wv->value = 0;
d01a7826 809 /* The intptr_t cast avoids a warning. There's no problem
279a1d4b 810 as long as pointers have enough bits to hold small integers. */
d01a7826 811 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
279a1d4b
CY
812 wv->enabled = !NILP (enable);
813
814 if (NILP (type))
815 wv->button_type = BUTTON_TYPE_NONE;
816 else if (EQ (type, QCradio))
817 wv->button_type = BUTTON_TYPE_RADIO;
818 else if (EQ (type, QCtoggle))
819 wv->button_type = BUTTON_TYPE_TOGGLE;
820 else
821 abort ();
822
823 wv->selected = !NILP (selected);
824 if (! STRINGP (help))
825 help = Qnil;
826
827 wv->help = help;
828
829 prev_wv = wv;
830
831 i += MENU_ITEMS_ITEM_LENGTH;
832 }
833 }
834
835 /* If we have just one "menu item"
836 that was originally a button, return it by itself. */
837 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
838 {
839 wv = first_wv->contents;
840 free_widget_value (first_wv);
841 return wv;
842 }
843
844 return first_wv;
845}
846
847/* Walk through the widget_value tree starting at FIRST_WV and update
848 the char * pointers from the corresponding lisp values.
849 We do this after building the whole tree, since GC may happen while the
850 tree is constructed, and small strings are relocated. So we must wait
851 until no GC can happen before storing pointers into lisp values. */
852void
971de7fb 853update_submenu_strings (widget_value *first_wv)
279a1d4b
CY
854{
855 widget_value *wv;
856
857 for (wv = first_wv; wv; wv = wv->next)
858 {
859 if (STRINGP (wv->lname))
860 {
51b59d79 861 wv->name = SSDATA (wv->lname);
279a1d4b
CY
862
863 /* Ignore the @ that means "separate pane".
864 This is a kludge, but this isn't worth more time. */
865 if (wv->value == (char *)1)
866 {
867 if (wv->name[0] == '@')
868 wv->name++;
869 wv->value = 0;
870 }
871 }
872
873 if (STRINGP (wv->lkey))
51b59d79 874 wv->key = SSDATA (wv->lkey);
279a1d4b
CY
875
876 if (wv->contents)
877 update_submenu_strings (wv->contents);
878 }
879}
880
881/* Find the menu selection and store it in the keyboard buffer.
882 F is the frame the menu is on.
883 MENU_BAR_ITEMS_USED is the length of VECTOR.
884 VECTOR is an array of menu events for the whole menu. */
885
886void
971de7fb 887find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
279a1d4b
CY
888{
889 Lisp_Object prefix, entry;
890 Lisp_Object *subprefix_stack;
891 int submenu_depth = 0;
892 int i;
893
894 entry = Qnil;
38182d90 895 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
279a1d4b
CY
896 prefix = Qnil;
897 i = 0;
898
899 while (i < menu_bar_items_used)
900 {
28be1ada 901 if (EQ (AREF (vector, i), Qnil))
279a1d4b
CY
902 {
903 subprefix_stack[submenu_depth++] = prefix;
904 prefix = entry;
905 i++;
906 }
28be1ada 907 else if (EQ (AREF (vector, i), Qlambda))
279a1d4b
CY
908 {
909 prefix = subprefix_stack[--submenu_depth];
910 i++;
911 }
28be1ada 912 else if (EQ (AREF (vector, i), Qt))
279a1d4b 913 {
28be1ada 914 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
279a1d4b
CY
915 i += MENU_ITEMS_PANE_LENGTH;
916 }
917 else
918 {
28be1ada 919 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
8ac068ac 920 /* Treat the pointer as an integer. There's no problem
279a1d4b 921 as long as pointers have enough bits to hold small integers. */
d01a7826 922 if ((intptr_t) client_data == i)
279a1d4b
CY
923 {
924 int j;
925 struct input_event buf;
926 Lisp_Object frame;
927 EVENT_INIT (buf);
928
929 XSETFRAME (frame, f);
930 buf.kind = MENU_BAR_EVENT;
931 buf.frame_or_window = frame;
932 buf.arg = frame;
933 kbd_buffer_store_event (&buf);
934
935 for (j = 0; j < submenu_depth; j++)
936 if (!NILP (subprefix_stack[j]))
937 {
938 buf.kind = MENU_BAR_EVENT;
939 buf.frame_or_window = frame;
940 buf.arg = subprefix_stack[j];
941 kbd_buffer_store_event (&buf);
942 }
943
944 if (!NILP (prefix))
945 {
946 buf.kind = MENU_BAR_EVENT;
947 buf.frame_or_window = frame;
948 buf.arg = prefix;
949 kbd_buffer_store_event (&buf);
950 }
951
952 buf.kind = MENU_BAR_EVENT;
953 buf.frame_or_window = frame;
954 buf.arg = entry;
955 kbd_buffer_store_event (&buf);
956
957 return;
958 }
959 i += MENU_ITEMS_ITEM_LENGTH;
960 }
961 }
962}
963
edfda783
AR
964#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
965
966#ifdef HAVE_NS
967/* As above, but return the menu selection instead of storing in kb buffer.
968 If keymaps==1, return full prefixes to selection. */
969Lisp_Object
970find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
971{
972 Lisp_Object prefix, entry;
973 int i;
974 Lisp_Object *subprefix_stack;
975 int submenu_depth = 0;
976
977 prefix = entry = Qnil;
978 i = 0;
979 subprefix_stack =
5e617bc2 980 (Lisp_Object *)alloca (menu_items_used * sizeof (Lisp_Object));
edfda783
AR
981
982 while (i < menu_items_used)
983 {
28be1ada 984 if (EQ (AREF (menu_items, i), Qnil))
edfda783
AR
985 {
986 subprefix_stack[submenu_depth++] = prefix;
987 prefix = entry;
988 i++;
989 }
28be1ada 990 else if (EQ (AREF (menu_items, i), Qlambda))
edfda783
AR
991 {
992 prefix = subprefix_stack[--submenu_depth];
993 i++;
994 }
28be1ada 995 else if (EQ (AREF (menu_items, i), Qt))
edfda783
AR
996 {
997 prefix
28be1ada 998 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
edfda783
AR
999 i += MENU_ITEMS_PANE_LENGTH;
1000 }
1001 /* Ignore a nil in the item list.
1002 It's meaningful only for dialog boxes. */
28be1ada 1003 else if (EQ (AREF (menu_items, i), Qquote))
edfda783
AR
1004 i += 1;
1005 else
1006 {
1007 entry
28be1ada 1008 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
4939150c 1009 if (aref_addr (menu_items, i) == client_data)
edfda783
AR
1010 {
1011 if (keymaps != 0)
1012 {
1013 int j;
1014
1015 entry = Fcons (entry, Qnil);
1016 if (!NILP (prefix))
1017 entry = Fcons (prefix, entry);
1018 for (j = submenu_depth - 1; j >= 0; j--)
1019 if (!NILP (subprefix_stack[j]))
1020 entry = Fcons (subprefix_stack[j], entry);
1021 }
1022 return entry;
1023 }
1024 i += MENU_ITEMS_ITEM_LENGTH;
1025 }
1026 }
facfbbbd 1027 return Qnil;
edfda783 1028}
31c2d412 1029#endif /* HAVE_NS */
279a1d4b 1030
a7ca3326 1031DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
ef7417fd
SM
1032 doc: /* Pop up a deck-of-cards menu and return user's selection.
1033POSITION is a position specification. This is either a mouse button event
1034or a list ((XOFFSET YOFFSET) WINDOW)
1035where XOFFSET and YOFFSET are positions in pixels from the top left
1036corner of WINDOW. (WINDOW may be a window or a frame object.)
1037This controls the position of the top left of the menu as a whole.
1038If POSITION is t, it means to use the current mouse position.
1039
1040MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1041The menu items come from key bindings that have a menu string as well as
1042a definition; actually, the "definition" in such a key binding looks like
1043\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1044the keymap as a top-level element.
1045
1046If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1047Otherwise, REAL-DEFINITION should be a valid key binding definition.
1048
1049You can also use a list of keymaps as MENU.
1050 Then each keymap makes a separate pane.
1051
1052When MENU is a keymap or a list of keymaps, the return value is the
1053list of events corresponding to the user's choice. Note that
1054`x-popup-menu' does not actually execute the command bound to that
1055sequence of events.
1056
1057Alternatively, you can specify a menu of multiple panes
1058 with a list of the form (TITLE PANE1 PANE2...),
1059where each pane is a list of form (TITLE ITEM1 ITEM2...).
1060Each ITEM is normally a cons cell (STRING . VALUE);
1061but a string can appear as an item--that makes a nonselectable line
1062in the menu.
1063With this form of menu, the return value is VALUE from the chosen item.
1064
1065If POSITION is nil, don't display the menu at all, just precalculate the
1066cached information about equivalent key sequences.
1067
1068If the user gets rid of the menu without making a valid choice, for
1069instance by clicking the mouse away from a valid choice or by typing
1070keyboard input, then this normally results in a quit and
1071`x-popup-menu' does not return. But if POSITION is a mouse button
1072event (indicating that the user invoked the menu with the mouse) then
1073no quit occurs and `x-popup-menu' returns nil. */)
5842a27b 1074 (Lisp_Object position, Lisp_Object menu)
ef7417fd
SM
1075{
1076 Lisp_Object keymap, tem;
1077 int xpos = 0, ypos = 0;
1078 Lisp_Object title;
42ca4633 1079 const char *error_name = NULL;
ef7417fd
SM
1080 Lisp_Object selection = Qnil;
1081 FRAME_PTR f = NULL;
1082 Lisp_Object x, y, window;
1083 int keymaps = 0;
1084 int for_click = 0;
d311d28c 1085 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
ef7417fd 1086 struct gcpro gcpro1;
ef7417fd 1087
ef7417fd
SM
1088 if (NILP (position))
1089 /* This is an obsolete call, which wants us to precompute the
1090 keybinding equivalents, but we don't do that any more anyway. */
1091 return Qnil;
1092
1093#ifdef HAVE_MENUS
1094 {
1095 int get_current_pos_p = 0;
1096 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1097
1098 /* Decode the first argument: find the window and the coordinates. */
1099 if (EQ (position, Qt)
1100 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1101 || EQ (XCAR (position), Qtool_bar))))
1102 {
1103 get_current_pos_p = 1;
1104 }
1105 else
1106 {
1107 tem = Fcar (position);
1108 if (CONSP (tem))
1109 {
1110 window = Fcar (Fcdr (position));
1111 x = XCAR (tem);
1112 y = Fcar (XCDR (tem));
1113 }
1114 else
1115 {
1116 for_click = 1;
1117 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1118 window = Fcar (tem); /* POSN_WINDOW (tem) */
a6d676d9
CY
1119 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1120 x = Fcar (tem);
1121 y = Fcdr (tem);
ef7417fd
SM
1122 }
1123
1124 /* If a click happens in an external tool bar or a detached
1125 tool bar, x and y is NIL. In that case, use the current
1126 mouse position. This happens for the help button in the
1127 tool bar. Ideally popup-menu should pass NIL to
1128 this function, but it doesn't. */
1129 if (NILP (x) && NILP (y))
1130 get_current_pos_p = 1;
1131 }
1132
1133 if (get_current_pos_p)
1134 {
1135 /* Use the mouse's current position. */
1136 FRAME_PTR new_f = SELECTED_FRAME ();
1137#ifdef HAVE_X_WINDOWS
1138 /* Can't use mouse_position_hook for X since it returns
1139 coordinates relative to the window the mouse is in,
1140 we need coordinates relative to the edit widget always. */
1141 if (new_f != 0)
1142 {
1143 int cur_x, cur_y;
1144
1145 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1146 /* cur_x/y may be negative, so use make_number. */
1147 x = make_number (cur_x);
1148 y = make_number (cur_y);
1149 }
1150
1151#else /* not HAVE_X_WINDOWS */
1152 Lisp_Object bar_window;
1153 enum scroll_bar_part part;
08dc5ae6 1154 Time time;
f57e2426
J
1155 void (*mouse_position_hook) (struct frame **, int,
1156 Lisp_Object *,
1157 enum scroll_bar_part *,
1158 Lisp_Object *,
1159 Lisp_Object *,
08dc5ae6 1160 Time *) =
ef7417fd
SM
1161 FRAME_TERMINAL (new_f)->mouse_position_hook;
1162
1163 if (mouse_position_hook)
1164 (*mouse_position_hook) (&new_f, 1, &bar_window,
1165 &part, &x, &y, &time);
1166#endif /* not HAVE_X_WINDOWS */
1167
1168 if (new_f != 0)
1169 XSETFRAME (window, new_f);
1170 else
1171 {
1172 window = selected_window;
1173 XSETFASTINT (x, 0);
1174 XSETFASTINT (y, 0);
1175 }
1176 }
1177
ef7417fd
SM
1178 /* Decode where to put the menu. */
1179
1180 if (FRAMEP (window))
1181 {
1182 f = XFRAME (window);
1183 xpos = 0;
1184 ypos = 0;
1185 }
1186 else if (WINDOWP (window))
1187 {
1188 struct window *win = XWINDOW (window);
1189 CHECK_LIVE_WINDOW (window);
1190 f = XFRAME (WINDOW_FRAME (win));
1191
ef7417fd
SM
1192 xpos = WINDOW_LEFT_EDGE_X (win);
1193 ypos = WINDOW_TOP_EDGE_Y (win);
ef7417fd
SM
1194 }
1195 else
1196 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1197 but I don't want to make one now. */
1198 CHECK_WINDOW (window);
1199
af5a5a98
AS
1200 CHECK_RANGED_INTEGER (x,
1201 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
d311d28c
PE
1202 ? (EMACS_INT) INT_MIN - xpos
1203 : MOST_NEGATIVE_FIXNUM),
af5a5a98
AS
1204 INT_MAX - xpos);
1205 CHECK_RANGED_INTEGER (y,
1206 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
d311d28c
PE
1207 ? (EMACS_INT) INT_MIN - ypos
1208 : MOST_NEGATIVE_FIXNUM),
af5a5a98 1209 INT_MAX - ypos);
ef7417fd
SM
1210 xpos += XINT (x);
1211 ypos += XINT (y);
1212
1213 /* FIXME: Find a more general check! */
1214 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1215 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1216 error ("Can not put GUI menu on this terminal");
1217
1218 XSETFRAME (Vmenu_updating_frame, f);
1219 }
1220#endif /* HAVE_MENUS */
1221
1222 /* Now parse the lisp menus. */
1223 record_unwind_protect (unuse_menu_items, Qnil);
1224
1225 title = Qnil;
1226 GCPRO1 (title);
1227
1228 /* Decode the menu items from what was specified. */
1229
1230 keymap = get_keymap (menu, 0, 0);
1231 if (CONSP (keymap))
1232 {
1233 /* We were given a keymap. Extract menu info from the keymap. */
1234 Lisp_Object prompt;
1235
1236 /* Extract the detailed info to make one pane. */
1237 keymap_panes (&menu, 1);
1238
1239 /* Search for a string appearing directly as an element of the keymap.
1240 That string is the title of the menu. */
1241 prompt = Fkeymap_prompt (keymap);
1242 if (!NILP (prompt))
1243 title = prompt;
1244#ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1245 else
1246 title = build_string ("Select");
1247#endif
1248
1249 /* Make that be the pane title of the first pane. */
1250 if (!NILP (prompt) && menu_items_n_panes >= 0)
1251 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1252
1253 keymaps = 1;
1254 }
1255 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1256 {
1257 /* We were given a list of keymaps. */
d311d28c
PE
1258 EMACS_INT nmaps = XFASTINT (Flength (menu));
1259 Lisp_Object *maps;
1260 ptrdiff_t i;
1261 USE_SAFE_ALLOCA;
ef7417fd 1262
d311d28c 1263 SAFE_ALLOCA_LISP (maps, nmaps);
ef7417fd
SM
1264 title = Qnil;
1265
1266 /* The first keymap that has a prompt string
1267 supplies the menu title. */
1268 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1269 {
1270 Lisp_Object prompt;
1271
1272 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1273
1274 prompt = Fkeymap_prompt (keymap);
1275 if (NILP (title) && !NILP (prompt))
1276 title = prompt;
1277 }
1278
1279 /* Extract the detailed info to make one pane. */
1280 keymap_panes (maps, nmaps);
1281
1282 /* Make the title be the pane title of the first pane. */
1283 if (!NILP (title) && menu_items_n_panes >= 0)
1284 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1285
1286 keymaps = 1;
d311d28c
PE
1287
1288 SAFE_FREE ();
ef7417fd
SM
1289 }
1290 else
1291 {
1292 /* We were given an old-fashioned menu. */
1293 title = Fcar (menu);
1294 CHECK_STRING (title);
1295
1296 list_of_panes (Fcdr (menu));
1297
1298 keymaps = 0;
1299 }
1300
1301 unbind_to (specpdl_count, Qnil);
1302
1303#ifdef HAVE_MENUS
dc92c039 1304#ifdef HAVE_WINDOW_SYSTEM
ef7417fd
SM
1305 /* Hide a previous tip, if any. */
1306 Fx_hide_tip ();
dc92c039 1307#endif
ef7417fd
SM
1308
1309#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1310 /* If resources from a previous popup menu still exist, does nothing
1311 until the `menu_free_timer' has freed them (see w32fns.c). This
1312 can occur if you press ESC or click outside a menu without selecting
1313 a menu item.
1314 */
1315 if (current_popup_menu)
1316 {
1317 discard_menu_items ();
1318 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1319 UNGCPRO;
1320 return Qnil;
1321 }
1322#endif
1323
1324#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1325 record_unwind_protect (cleanup_popup_menu, Qnil);
1326#endif
1327
1328 /* Display them in a menu. */
1329 BLOCK_INPUT;
1330
1331 /* FIXME: Use a terminal hook! */
1332#if defined HAVE_NTGUI
1333 selection = w32_menu_show (f, xpos, ypos, for_click,
1334 keymaps, title, &error_name);
1335#elif defined HAVE_NS
1336 selection = ns_menu_show (f, xpos, ypos, for_click,
1337 keymaps, title, &error_name);
1338#else /* MSDOS and X11 */
a6d676d9
CY
1339 /* Assume last_event_timestamp is the timestamp of the button event.
1340 Is this assumption ever violated? We can't use the timestamp
1341 stored within POSITION because there the top bits from the actual
1342 timestamp may be truncated away (Bug#4930). */
ef7417fd
SM
1343 selection = xmenu_show (f, xpos, ypos, for_click,
1344 keymaps, title, &error_name,
a6d676d9 1345 last_event_timestamp);
ef7417fd
SM
1346#endif
1347
1348 UNBLOCK_INPUT;
1349
1350#ifdef HAVE_NS
1351 unbind_to (specpdl_count, Qnil);
1352#else
1353 discard_menu_items ();
1354#endif
1355
1356#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1357 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1358#endif
1359
1360#endif /* HAVE_MENUS */
1361
1362 UNGCPRO;
1363
42eea0d0 1364 if (error_name) error ("%s", error_name);
ef7417fd
SM
1365 return selection;
1366}
1367
279a1d4b 1368void
971de7fb 1369syms_of_menu (void)
279a1d4b
CY
1370{
1371 staticpro (&menu_items);
1372 menu_items = Qnil;
1373 menu_items_inuse = Qnil;
ef7417fd
SM
1374
1375 defsubr (&Sx_popup_menu);
279a1d4b 1376}