Generalize run-time debugging checks.
[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
635 submenu_stack
636 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
637 wv = xmalloc_widget_value ();
638 wv->name = "menu";
639 wv->value = 0;
640 wv->enabled = 1;
641 wv->button_type = BUTTON_TYPE_NONE;
642 wv->help = Qnil;
643 first_wv = wv;
644 save_wv = 0;
645 prev_wv = 0;
646
647 /* Loop over all panes and items made by the preceding call
648 to parse_single_submenu and construct a tree of widget_value objects.
649 Ignore the panes and items used by previous calls to
650 digest_single_submenu, even though those are also in menu_items. */
651 i = start;
652 while (i < end)
653 {
28be1ada 654 if (EQ (AREF (menu_items, i), Qnil))
279a1d4b
CY
655 {
656 submenu_stack[submenu_depth++] = save_wv;
657 save_wv = prev_wv;
658 prev_wv = 0;
659 i++;
660 }
28be1ada 661 else if (EQ (AREF (menu_items, i), Qlambda))
279a1d4b
CY
662 {
663 prev_wv = save_wv;
664 save_wv = submenu_stack[--submenu_depth];
665 i++;
666 }
28be1ada 667 else if (EQ (AREF (menu_items, i), Qt)
279a1d4b
CY
668 && submenu_depth != 0)
669 i += MENU_ITEMS_PANE_LENGTH;
670 /* Ignore a nil in the item list.
671 It's meaningful only for dialog boxes. */
28be1ada 672 else if (EQ (AREF (menu_items, i), Qquote))
279a1d4b 673 i += 1;
28be1ada 674 else if (EQ (AREF (menu_items, i), Qt))
279a1d4b
CY
675 {
676 /* Create a new pane. */
b01a1c29 677 Lisp_Object pane_name;
675e2c69 678 const char *pane_string;
279a1d4b
CY
679
680 panes_seen++;
681
28be1ada 682 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
279a1d4b
CY
683
684#ifdef HAVE_NTGUI
685 if (STRINGP (pane_name))
686 {
687 if (unicode_append_menu)
688 /* Encode as UTF-8 for now. */
689 pane_name = ENCODE_UTF_8 (pane_name);
690 else if (STRING_MULTIBYTE (pane_name))
691 pane_name = ENCODE_SYSTEM (pane_name);
692
693 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
694 }
99852628
JD
695#elif defined (USE_LUCID) && defined (HAVE_XFT)
696 if (STRINGP (pane_name))
697 {
698 pane_name = ENCODE_UTF_8 (pane_name);
699 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
700 }
279a1d4b
CY
701#elif !defined (HAVE_MULTILINGUAL_MENU)
702 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
703 {
704 pane_name = ENCODE_MENU_STRING (pane_name);
705 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
706 }
707#endif
708
709 pane_string = (NILP (pane_name)
51b59d79 710 ? "" : SSDATA (pane_name));
279a1d4b
CY
711 /* If there is just one top-level pane, put all its items directly
712 under the top-level menu. */
713 if (menu_items_n_panes == 1)
714 pane_string = "";
715
716 /* If the pane has a meaningful name,
717 make the pane a top-level menu item
718 with its items as a submenu beneath it. */
719 if (strcmp (pane_string, ""))
720 {
721 wv = xmalloc_widget_value ();
722 if (save_wv)
723 save_wv->next = wv;
724 else
725 first_wv->contents = wv;
726 wv->lname = pane_name;
727 /* Set value to 1 so update_submenu_strings can handle '@' */
728 wv->value = (char *)1;
729 wv->enabled = 1;
730 wv->button_type = BUTTON_TYPE_NONE;
731 wv->help = Qnil;
732 save_wv = wv;
733 }
734 else
735 save_wv = first_wv;
736
737 prev_wv = 0;
738 i += MENU_ITEMS_PANE_LENGTH;
739 }
740 else
741 {
742 /* Create a new item within current pane. */
743 Lisp_Object item_name, enable, descrip, def, type, selected;
744 Lisp_Object help;
745
746 /* All items should be contained in panes. */
747 if (panes_seen == 0)
748 abort ();
749
750 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
751 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
752 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
753 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
754 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
755 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
756 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
757
758#ifdef HAVE_NTGUI
759 if (STRINGP (item_name))
760 {
761 if (unicode_append_menu)
762 item_name = ENCODE_UTF_8 (item_name);
763 else if (STRING_MULTIBYTE (item_name))
764 item_name = ENCODE_SYSTEM (item_name);
765
766 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
767 }
768
769 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
770 {
771 descrip = ENCODE_SYSTEM (descrip);
772 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
773 }
99852628
JD
774#elif USE_LUCID
775 if (STRINGP (item_name))
776 {
777 item_name = ENCODE_UTF_8 (item_name);
778 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
779 }
780
781 if (STRINGP (descrip))
782 {
783 descrip = ENCODE_UTF_8 (descrip);
784 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
785 }
279a1d4b
CY
786#elif !defined (HAVE_MULTILINGUAL_MENU)
787 if (STRING_MULTIBYTE (item_name))
788 {
789 item_name = ENCODE_MENU_STRING (item_name);
790 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
791 }
792
793 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
794 {
795 descrip = ENCODE_MENU_STRING (descrip);
796 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
797 }
798#endif
799
800 wv = xmalloc_widget_value ();
801 if (prev_wv)
802 prev_wv->next = wv;
803 else
804 save_wv->contents = wv;
805
806 wv->lname = item_name;
807 if (!NILP (descrip))
808 wv->lkey = descrip;
809 wv->value = 0;
d01a7826 810 /* The intptr_t cast avoids a warning. There's no problem
279a1d4b 811 as long as pointers have enough bits to hold small integers. */
d01a7826 812 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
279a1d4b
CY
813 wv->enabled = !NILP (enable);
814
815 if (NILP (type))
816 wv->button_type = BUTTON_TYPE_NONE;
817 else if (EQ (type, QCradio))
818 wv->button_type = BUTTON_TYPE_RADIO;
819 else if (EQ (type, QCtoggle))
820 wv->button_type = BUTTON_TYPE_TOGGLE;
821 else
822 abort ();
823
824 wv->selected = !NILP (selected);
825 if (! STRINGP (help))
826 help = Qnil;
827
828 wv->help = help;
829
830 prev_wv = wv;
831
832 i += MENU_ITEMS_ITEM_LENGTH;
833 }
834 }
835
836 /* If we have just one "menu item"
837 that was originally a button, return it by itself. */
838 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
839 {
840 wv = first_wv->contents;
841 free_widget_value (first_wv);
842 return wv;
843 }
844
845 return first_wv;
846}
847
848/* Walk through the widget_value tree starting at FIRST_WV and update
849 the char * pointers from the corresponding lisp values.
850 We do this after building the whole tree, since GC may happen while the
851 tree is constructed, and small strings are relocated. So we must wait
852 until no GC can happen before storing pointers into lisp values. */
853void
971de7fb 854update_submenu_strings (widget_value *first_wv)
279a1d4b
CY
855{
856 widget_value *wv;
857
858 for (wv = first_wv; wv; wv = wv->next)
859 {
860 if (STRINGP (wv->lname))
861 {
51b59d79 862 wv->name = SSDATA (wv->lname);
279a1d4b
CY
863
864 /* Ignore the @ that means "separate pane".
865 This is a kludge, but this isn't worth more time. */
866 if (wv->value == (char *)1)
867 {
868 if (wv->name[0] == '@')
869 wv->name++;
870 wv->value = 0;
871 }
872 }
873
874 if (STRINGP (wv->lkey))
51b59d79 875 wv->key = SSDATA (wv->lkey);
279a1d4b
CY
876
877 if (wv->contents)
878 update_submenu_strings (wv->contents);
879 }
880}
881
882/* Find the menu selection and store it in the keyboard buffer.
883 F is the frame the menu is on.
884 MENU_BAR_ITEMS_USED is the length of VECTOR.
885 VECTOR is an array of menu events for the whole menu. */
886
887void
971de7fb 888find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
279a1d4b
CY
889{
890 Lisp_Object prefix, entry;
891 Lisp_Object *subprefix_stack;
892 int submenu_depth = 0;
893 int i;
894
895 entry = Qnil;
896 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
897 prefix = Qnil;
898 i = 0;
899
900 while (i < menu_bar_items_used)
901 {
28be1ada 902 if (EQ (AREF (vector, i), Qnil))
279a1d4b
CY
903 {
904 subprefix_stack[submenu_depth++] = prefix;
905 prefix = entry;
906 i++;
907 }
28be1ada 908 else if (EQ (AREF (vector, i), Qlambda))
279a1d4b
CY
909 {
910 prefix = subprefix_stack[--submenu_depth];
911 i++;
912 }
28be1ada 913 else if (EQ (AREF (vector, i), Qt))
279a1d4b 914 {
28be1ada 915 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
279a1d4b
CY
916 i += MENU_ITEMS_PANE_LENGTH;
917 }
918 else
919 {
28be1ada 920 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
8ac068ac 921 /* Treat the pointer as an integer. There's no problem
279a1d4b 922 as long as pointers have enough bits to hold small integers. */
d01a7826 923 if ((intptr_t) client_data == i)
279a1d4b
CY
924 {
925 int j;
926 struct input_event buf;
927 Lisp_Object frame;
928 EVENT_INIT (buf);
929
930 XSETFRAME (frame, f);
931 buf.kind = MENU_BAR_EVENT;
932 buf.frame_or_window = frame;
933 buf.arg = frame;
934 kbd_buffer_store_event (&buf);
935
936 for (j = 0; j < submenu_depth; j++)
937 if (!NILP (subprefix_stack[j]))
938 {
939 buf.kind = MENU_BAR_EVENT;
940 buf.frame_or_window = frame;
941 buf.arg = subprefix_stack[j];
942 kbd_buffer_store_event (&buf);
943 }
944
945 if (!NILP (prefix))
946 {
947 buf.kind = MENU_BAR_EVENT;
948 buf.frame_or_window = frame;
949 buf.arg = prefix;
950 kbd_buffer_store_event (&buf);
951 }
952
953 buf.kind = MENU_BAR_EVENT;
954 buf.frame_or_window = frame;
955 buf.arg = entry;
956 kbd_buffer_store_event (&buf);
957
958 return;
959 }
960 i += MENU_ITEMS_ITEM_LENGTH;
961 }
962 }
963}
964
edfda783
AR
965#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
966
967#ifdef HAVE_NS
968/* As above, but return the menu selection instead of storing in kb buffer.
969 If keymaps==1, return full prefixes to selection. */
970Lisp_Object
971find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
972{
973 Lisp_Object prefix, entry;
974 int i;
975 Lisp_Object *subprefix_stack;
976 int submenu_depth = 0;
977
978 prefix = entry = Qnil;
979 i = 0;
980 subprefix_stack =
5e617bc2 981 (Lisp_Object *)alloca (menu_items_used * sizeof (Lisp_Object));
edfda783
AR
982
983 while (i < menu_items_used)
984 {
28be1ada 985 if (EQ (AREF (menu_items, i), Qnil))
edfda783
AR
986 {
987 subprefix_stack[submenu_depth++] = prefix;
988 prefix = entry;
989 i++;
990 }
28be1ada 991 else if (EQ (AREF (menu_items, i), Qlambda))
edfda783
AR
992 {
993 prefix = subprefix_stack[--submenu_depth];
994 i++;
995 }
28be1ada 996 else if (EQ (AREF (menu_items, i), Qt))
edfda783
AR
997 {
998 prefix
28be1ada 999 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
edfda783
AR
1000 i += MENU_ITEMS_PANE_LENGTH;
1001 }
1002 /* Ignore a nil in the item list.
1003 It's meaningful only for dialog boxes. */
28be1ada 1004 else if (EQ (AREF (menu_items, i), Qquote))
edfda783
AR
1005 i += 1;
1006 else
1007 {
1008 entry
28be1ada
DA
1009 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1010 if (&AREF (menu_items, i) == client_data)
edfda783
AR
1011 {
1012 if (keymaps != 0)
1013 {
1014 int j;
1015
1016 entry = Fcons (entry, Qnil);
1017 if (!NILP (prefix))
1018 entry = Fcons (prefix, entry);
1019 for (j = submenu_depth - 1; j >= 0; j--)
1020 if (!NILP (subprefix_stack[j]))
1021 entry = Fcons (subprefix_stack[j], entry);
1022 }
1023 return entry;
1024 }
1025 i += MENU_ITEMS_ITEM_LENGTH;
1026 }
1027 }
facfbbbd 1028 return Qnil;
edfda783 1029}
31c2d412 1030#endif /* HAVE_NS */
279a1d4b 1031
a7ca3326 1032DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
ef7417fd
SM
1033 doc: /* Pop up a deck-of-cards menu and return user's selection.
1034POSITION is a position specification. This is either a mouse button event
1035or a list ((XOFFSET YOFFSET) WINDOW)
1036where XOFFSET and YOFFSET are positions in pixels from the top left
1037corner of WINDOW. (WINDOW may be a window or a frame object.)
1038This controls the position of the top left of the menu as a whole.
1039If POSITION is t, it means to use the current mouse position.
1040
1041MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1042The menu items come from key bindings that have a menu string as well as
1043a definition; actually, the "definition" in such a key binding looks like
1044\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1045the keymap as a top-level element.
1046
1047If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1048Otherwise, REAL-DEFINITION should be a valid key binding definition.
1049
1050You can also use a list of keymaps as MENU.
1051 Then each keymap makes a separate pane.
1052
1053When MENU is a keymap or a list of keymaps, the return value is the
1054list of events corresponding to the user's choice. Note that
1055`x-popup-menu' does not actually execute the command bound to that
1056sequence of events.
1057
1058Alternatively, you can specify a menu of multiple panes
1059 with a list of the form (TITLE PANE1 PANE2...),
1060where each pane is a list of form (TITLE ITEM1 ITEM2...).
1061Each ITEM is normally a cons cell (STRING . VALUE);
1062but a string can appear as an item--that makes a nonselectable line
1063in the menu.
1064With this form of menu, the return value is VALUE from the chosen item.
1065
1066If POSITION is nil, don't display the menu at all, just precalculate the
1067cached information about equivalent key sequences.
1068
1069If the user gets rid of the menu without making a valid choice, for
1070instance by clicking the mouse away from a valid choice or by typing
1071keyboard input, then this normally results in a quit and
1072`x-popup-menu' does not return. But if POSITION is a mouse button
1073event (indicating that the user invoked the menu with the mouse) then
1074no quit occurs and `x-popup-menu' returns nil. */)
5842a27b 1075 (Lisp_Object position, Lisp_Object menu)
ef7417fd
SM
1076{
1077 Lisp_Object keymap, tem;
1078 int xpos = 0, ypos = 0;
1079 Lisp_Object title;
42ca4633 1080 const char *error_name = NULL;
ef7417fd
SM
1081 Lisp_Object selection = Qnil;
1082 FRAME_PTR f = NULL;
1083 Lisp_Object x, y, window;
1084 int keymaps = 0;
1085 int for_click = 0;
d311d28c 1086 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
ef7417fd 1087 struct gcpro gcpro1;
ef7417fd 1088
ef7417fd
SM
1089 if (NILP (position))
1090 /* This is an obsolete call, which wants us to precompute the
1091 keybinding equivalents, but we don't do that any more anyway. */
1092 return Qnil;
1093
1094#ifdef HAVE_MENUS
1095 {
1096 int get_current_pos_p = 0;
1097 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1098
1099 /* Decode the first argument: find the window and the coordinates. */
1100 if (EQ (position, Qt)
1101 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1102 || EQ (XCAR (position), Qtool_bar))))
1103 {
1104 get_current_pos_p = 1;
1105 }
1106 else
1107 {
1108 tem = Fcar (position);
1109 if (CONSP (tem))
1110 {
1111 window = Fcar (Fcdr (position));
1112 x = XCAR (tem);
1113 y = Fcar (XCDR (tem));
1114 }
1115 else
1116 {
1117 for_click = 1;
1118 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1119 window = Fcar (tem); /* POSN_WINDOW (tem) */
a6d676d9
CY
1120 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1121 x = Fcar (tem);
1122 y = Fcdr (tem);
ef7417fd
SM
1123 }
1124
1125 /* If a click happens in an external tool bar or a detached
1126 tool bar, x and y is NIL. In that case, use the current
1127 mouse position. This happens for the help button in the
1128 tool bar. Ideally popup-menu should pass NIL to
1129 this function, but it doesn't. */
1130 if (NILP (x) && NILP (y))
1131 get_current_pos_p = 1;
1132 }
1133
1134 if (get_current_pos_p)
1135 {
1136 /* Use the mouse's current position. */
1137 FRAME_PTR new_f = SELECTED_FRAME ();
1138#ifdef HAVE_X_WINDOWS
1139 /* Can't use mouse_position_hook for X since it returns
1140 coordinates relative to the window the mouse is in,
1141 we need coordinates relative to the edit widget always. */
1142 if (new_f != 0)
1143 {
1144 int cur_x, cur_y;
1145
1146 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1147 /* cur_x/y may be negative, so use make_number. */
1148 x = make_number (cur_x);
1149 y = make_number (cur_y);
1150 }
1151
1152#else /* not HAVE_X_WINDOWS */
1153 Lisp_Object bar_window;
1154 enum scroll_bar_part part;
08dc5ae6 1155 Time time;
f57e2426
J
1156 void (*mouse_position_hook) (struct frame **, int,
1157 Lisp_Object *,
1158 enum scroll_bar_part *,
1159 Lisp_Object *,
1160 Lisp_Object *,
08dc5ae6 1161 Time *) =
ef7417fd
SM
1162 FRAME_TERMINAL (new_f)->mouse_position_hook;
1163
1164 if (mouse_position_hook)
1165 (*mouse_position_hook) (&new_f, 1, &bar_window,
1166 &part, &x, &y, &time);
1167#endif /* not HAVE_X_WINDOWS */
1168
1169 if (new_f != 0)
1170 XSETFRAME (window, new_f);
1171 else
1172 {
1173 window = selected_window;
1174 XSETFASTINT (x, 0);
1175 XSETFASTINT (y, 0);
1176 }
1177 }
1178
ef7417fd
SM
1179 /* Decode where to put the menu. */
1180
1181 if (FRAMEP (window))
1182 {
1183 f = XFRAME (window);
1184 xpos = 0;
1185 ypos = 0;
1186 }
1187 else if (WINDOWP (window))
1188 {
1189 struct window *win = XWINDOW (window);
1190 CHECK_LIVE_WINDOW (window);
1191 f = XFRAME (WINDOW_FRAME (win));
1192
ef7417fd
SM
1193 xpos = WINDOW_LEFT_EDGE_X (win);
1194 ypos = WINDOW_TOP_EDGE_Y (win);
ef7417fd
SM
1195 }
1196 else
1197 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1198 but I don't want to make one now. */
1199 CHECK_WINDOW (window);
1200
d311d28c
PE
1201 CHECK_RANGED_INTEGER ((xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1202 ? (EMACS_INT) INT_MIN - xpos
1203 : MOST_NEGATIVE_FIXNUM),
1204 x, INT_MAX - xpos);
1205 CHECK_RANGED_INTEGER ((ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1206 ? (EMACS_INT) INT_MIN - ypos
1207 : MOST_NEGATIVE_FIXNUM),
1208 y, INT_MAX - ypos);
ef7417fd
SM
1209 xpos += XINT (x);
1210 ypos += XINT (y);
1211
1212 /* FIXME: Find a more general check! */
1213 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1214 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1215 error ("Can not put GUI menu on this terminal");
1216
1217 XSETFRAME (Vmenu_updating_frame, f);
1218 }
1219#endif /* HAVE_MENUS */
1220
1221 /* Now parse the lisp menus. */
1222 record_unwind_protect (unuse_menu_items, Qnil);
1223
1224 title = Qnil;
1225 GCPRO1 (title);
1226
1227 /* Decode the menu items from what was specified. */
1228
1229 keymap = get_keymap (menu, 0, 0);
1230 if (CONSP (keymap))
1231 {
1232 /* We were given a keymap. Extract menu info from the keymap. */
1233 Lisp_Object prompt;
1234
1235 /* Extract the detailed info to make one pane. */
1236 keymap_panes (&menu, 1);
1237
1238 /* Search for a string appearing directly as an element of the keymap.
1239 That string is the title of the menu. */
1240 prompt = Fkeymap_prompt (keymap);
1241 if (!NILP (prompt))
1242 title = prompt;
1243#ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1244 else
1245 title = build_string ("Select");
1246#endif
1247
1248 /* Make that be the pane title of the first pane. */
1249 if (!NILP (prompt) && menu_items_n_panes >= 0)
1250 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1251
1252 keymaps = 1;
1253 }
1254 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1255 {
1256 /* We were given a list of keymaps. */
d311d28c
PE
1257 EMACS_INT nmaps = XFASTINT (Flength (menu));
1258 Lisp_Object *maps;
1259 ptrdiff_t i;
1260 USE_SAFE_ALLOCA;
ef7417fd 1261
d311d28c 1262 SAFE_ALLOCA_LISP (maps, nmaps);
ef7417fd
SM
1263 title = Qnil;
1264
1265 /* The first keymap that has a prompt string
1266 supplies the menu title. */
1267 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1268 {
1269 Lisp_Object prompt;
1270
1271 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1272
1273 prompt = Fkeymap_prompt (keymap);
1274 if (NILP (title) && !NILP (prompt))
1275 title = prompt;
1276 }
1277
1278 /* Extract the detailed info to make one pane. */
1279 keymap_panes (maps, nmaps);
1280
1281 /* Make the title be the pane title of the first pane. */
1282 if (!NILP (title) && menu_items_n_panes >= 0)
1283 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1284
1285 keymaps = 1;
d311d28c
PE
1286
1287 SAFE_FREE ();
ef7417fd
SM
1288 }
1289 else
1290 {
1291 /* We were given an old-fashioned menu. */
1292 title = Fcar (menu);
1293 CHECK_STRING (title);
1294
1295 list_of_panes (Fcdr (menu));
1296
1297 keymaps = 0;
1298 }
1299
1300 unbind_to (specpdl_count, Qnil);
1301
1302#ifdef HAVE_MENUS
dc92c039 1303#ifdef HAVE_WINDOW_SYSTEM
ef7417fd
SM
1304 /* Hide a previous tip, if any. */
1305 Fx_hide_tip ();
dc92c039 1306#endif
ef7417fd
SM
1307
1308#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1309 /* If resources from a previous popup menu still exist, does nothing
1310 until the `menu_free_timer' has freed them (see w32fns.c). This
1311 can occur if you press ESC or click outside a menu without selecting
1312 a menu item.
1313 */
1314 if (current_popup_menu)
1315 {
1316 discard_menu_items ();
1317 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1318 UNGCPRO;
1319 return Qnil;
1320 }
1321#endif
1322
1323#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1324 record_unwind_protect (cleanup_popup_menu, Qnil);
1325#endif
1326
1327 /* Display them in a menu. */
1328 BLOCK_INPUT;
1329
1330 /* FIXME: Use a terminal hook! */
1331#if defined HAVE_NTGUI
1332 selection = w32_menu_show (f, xpos, ypos, for_click,
1333 keymaps, title, &error_name);
1334#elif defined HAVE_NS
1335 selection = ns_menu_show (f, xpos, ypos, for_click,
1336 keymaps, title, &error_name);
1337#else /* MSDOS and X11 */
a6d676d9
CY
1338 /* Assume last_event_timestamp is the timestamp of the button event.
1339 Is this assumption ever violated? We can't use the timestamp
1340 stored within POSITION because there the top bits from the actual
1341 timestamp may be truncated away (Bug#4930). */
ef7417fd
SM
1342 selection = xmenu_show (f, xpos, ypos, for_click,
1343 keymaps, title, &error_name,
a6d676d9 1344 last_event_timestamp);
ef7417fd
SM
1345#endif
1346
1347 UNBLOCK_INPUT;
1348
1349#ifdef HAVE_NS
1350 unbind_to (specpdl_count, Qnil);
1351#else
1352 discard_menu_items ();
1353#endif
1354
1355#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1356 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1357#endif
1358
1359#endif /* HAVE_MENUS */
1360
1361 UNGCPRO;
1362
42eea0d0 1363 if (error_name) error ("%s", error_name);
ef7417fd
SM
1364 return selection;
1365}
1366
279a1d4b 1367void
971de7fb 1368syms_of_menu (void)
279a1d4b
CY
1369{
1370 staticpro (&menu_items);
1371 menu_items = Qnil;
1372 menu_items_inuse = Qnil;
ef7417fd
SM
1373
1374 defsubr (&Sx_popup_menu);
279a1d4b 1375}