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