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