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