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