Add an index for explicit selective display.
[bpt/emacs.git] / src / menu.c
CommitLineData
279a1d4b 1/* Platform-independent code for terminal communications.
95df8112 2
ab422c4d
PE
3Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2013 Free Software
4Foundation, Inc.
279a1d4b
CY
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software: you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation, either version 3 of the License, or
11(at your option) any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21#include <config.h>
22#include <stdio.h>
3c24731f 23#include <limits.h> /* for INT_MAX */
279a1d4b
CY
24
25#include "lisp.h"
26#include "keyboard.h"
27#include "keymap.h"
28#include "frame.h"
ef7417fd 29#include "window.h"
279a1d4b
CY
30#include "termhooks.h"
31#include "blockinput.h"
32#include "dispextern.h"
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{
279a1d4b 58#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
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
f1303b52
EZ
418 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
419 && !NILP (map))
279a1d4b
CY
420 /* Indicate visually that this is a submenu. */
421 item_string = concat2 (item_string, build_string (" >"));
279a1d4b
CY
422
423 push_menu_item (item_string, enabled, key,
28be1ada
DA
424 AREF (item_properties, ITEM_PROPERTY_DEF),
425 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
426 AREF (item_properties, ITEM_PROPERTY_TYPE),
427 AREF (item_properties, ITEM_PROPERTY_SELECTED),
428 AREF (item_properties, ITEM_PROPERTY_HELP));
279a1d4b 429
edfda783 430#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
279a1d4b 431 /* Display a submenu using the toolkit. */
f1303b52
EZ
432 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
433 && ! (NILP (map) || NILP (enabled)))
279a1d4b
CY
434 {
435 push_submenu_start ();
ef7417fd 436 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
279a1d4b
CY
437 push_submenu_end ();
438 }
439#endif
440}
441
442/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
ef7417fd 443 and generate menu panes for them in menu_items. */
279a1d4b 444
ef7417fd 445static void
d311d28c 446keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
279a1d4b 447{
d311d28c 448 ptrdiff_t mapno;
279a1d4b
CY
449
450 init_menu_items ();
451
452 /* Loop over the given keymaps, making a pane for each map.
453 But don't make a pane that is empty--ignore that map instead.
454 P is the number of panes we have made so far. */
455 for (mapno = 0; mapno < nmaps; mapno++)
456 single_keymap_panes (keymaps[mapno],
ef7417fd 457 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
279a1d4b
CY
458
459 finish_menu_items ();
460}
461
06284c32
EZ
462/* Encode a menu string as appropriate for menu-updating-frame's type. */
463static Lisp_Object
464encode_menu_string (Lisp_Object str)
465{
466 /* TTY menu strings are encoded by write_glyphs, when they are
467 delivered to the glass, so no need to encode them here. */
468 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)))
469 return str;
470 return ENCODE_MENU_STRING (str);
471}
279a1d4b
CY
472
473/* Push the items in a single pane defined by the alist PANE. */
474static void
971de7fb 475list_of_items (Lisp_Object pane)
279a1d4b
CY
476{
477 Lisp_Object tail, item, item1;
478
479 for (tail = pane; CONSP (tail); tail = XCDR (tail))
480 {
481 item = XCAR (tail);
482 if (STRINGP (item))
06284c32 483 push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt,
279a1d4b
CY
484 Qnil, Qnil, Qnil, Qnil);
485 else if (CONSP (item))
486 {
487 item1 = XCAR (item);
488 CHECK_STRING (item1);
06284c32 489 push_menu_item (encode_menu_string (item1), Qt, XCDR (item),
279a1d4b
CY
490 Qt, Qnil, Qnil, Qnil, Qnil);
491 }
492 else
493 push_left_right_boundary ();
494
495 }
496}
497
498/* Push all the panes and items of a menu described by the
499 alist-of-alists MENU.
500 This handles old-fashioned calls to x-popup-menu. */
501void
971de7fb 502list_of_panes (Lisp_Object menu)
279a1d4b
CY
503{
504 Lisp_Object tail;
505
506 init_menu_items ();
507
508 for (tail = menu; CONSP (tail); tail = XCDR (tail))
509 {
510 Lisp_Object elt, pane_name, pane_data;
511 elt = XCAR (tail);
512 pane_name = Fcar (elt);
513 CHECK_STRING (pane_name);
06284c32 514 push_menu_pane (encode_menu_string (pane_name), Qnil);
279a1d4b
CY
515 pane_data = Fcdr (elt);
516 CHECK_CONS (pane_data);
517 list_of_items (pane_data);
518 }
519
520 finish_menu_items ();
521}
522
523/* Set up data in menu_items for a menu bar item
524 whose event type is ITEM_KEY (with string ITEM_NAME)
525 and whose contents come from the list of keymaps MAPS. */
7cded46f
PE
526bool
527parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
528 Lisp_Object maps)
279a1d4b
CY
529{
530 Lisp_Object length;
d311d28c 531 EMACS_INT len;
279a1d4b 532 Lisp_Object *mapvec;
d311d28c 533 ptrdiff_t i;
7cded46f 534 bool top_level_items = 0;
d311d28c 535 USE_SAFE_ALLOCA;
279a1d4b
CY
536
537 length = Flength (maps);
538 len = XINT (length);
539
540 /* Convert the list MAPS into a vector MAPVEC. */
d311d28c 541 SAFE_ALLOCA_LISP (mapvec, len);
279a1d4b
CY
542 for (i = 0; i < len; i++)
543 {
544 mapvec[i] = Fcar (maps);
545 maps = Fcdr (maps);
546 }
547
548 /* Loop over the given keymaps, making a pane for each map.
549 But don't make a pane that is empty--ignore that map instead. */
550 for (i = 0; i < len; i++)
551 {
552 if (!KEYMAPP (mapvec[i]))
553 {
554 /* Here we have a command at top level in the menu bar
555 as opposed to a submenu. */
556 top_level_items = 1;
557 push_menu_pane (Qnil, Qnil);
558 push_menu_item (item_name, Qt, item_key, mapvec[i],
559 Qnil, Qnil, Qnil, Qnil);
560 }
561 else
562 {
563 Lisp_Object prompt;
564 prompt = Fkeymap_prompt (mapvec[i]);
565 single_keymap_panes (mapvec[i],
566 !NILP (prompt) ? prompt : item_name,
ef7417fd 567 item_key, 10);
279a1d4b
CY
568 }
569 }
570
d311d28c 571 SAFE_FREE ();
279a1d4b
CY
572 return top_level_items;
573}
574
575\f
edfda783 576#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
279a1d4b
CY
577
578/* Allocate a widget_value, blocking input. */
579
580widget_value *
971de7fb 581xmalloc_widget_value (void)
279a1d4b
CY
582{
583 widget_value *value;
584
4d7e6e51 585 block_input ();
279a1d4b 586 value = malloc_widget_value ();
4d7e6e51 587 unblock_input ();
279a1d4b
CY
588
589 return value;
590}
591
592/* This recursively calls free_widget_value on the tree of widgets.
593 It must free all data that was malloc'ed for these widget_values.
594 In Emacs, many slots are pointers into the data of Lisp_Strings, and
595 must be left alone. */
596
597void
971de7fb 598free_menubar_widget_value_tree (widget_value *wv)
279a1d4b
CY
599{
600 if (! wv) return;
601
602 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
603
604 if (wv->contents && (wv->contents != (widget_value*)1))
605 {
606 free_menubar_widget_value_tree (wv->contents);
607 wv->contents = (widget_value *) 0xDEADBEEF;
608 }
609 if (wv->next)
610 {
611 free_menubar_widget_value_tree (wv->next);
612 wv->next = (widget_value *) 0xDEADBEEF;
613 }
4d7e6e51 614 block_input ();
279a1d4b 615 free_widget_value (wv);
4d7e6e51 616 unblock_input ();
279a1d4b
CY
617}
618
619/* Create a tree of widget_value objects
620 representing the panes and items
621 in menu_items starting at index START, up to index END. */
622
623widget_value *
7cded46f 624digest_single_submenu (int start, int end, bool top_level_items)
279a1d4b
CY
625{
626 widget_value *wv, *prev_wv, *save_wv, *first_wv;
627 int i;
628 int submenu_depth = 0;
629 widget_value **submenu_stack;
7cded46f 630 bool panes_seen = 0;
06284c32 631 struct frame *f = XFRAME (Vmenu_updating_frame);
279a1d4b 632
38182d90 633 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
279a1d4b
CY
634 wv = xmalloc_widget_value ();
635 wv->name = "menu";
636 wv->value = 0;
637 wv->enabled = 1;
638 wv->button_type = BUTTON_TYPE_NONE;
639 wv->help = Qnil;
640 first_wv = wv;
641 save_wv = 0;
642 prev_wv = 0;
643
644 /* Loop over all panes and items made by the preceding call
645 to parse_single_submenu and construct a tree of widget_value objects.
646 Ignore the panes and items used by previous calls to
647 digest_single_submenu, even though those are also in menu_items. */
648 i = start;
649 while (i < end)
650 {
28be1ada 651 if (EQ (AREF (menu_items, i), Qnil))
279a1d4b
CY
652 {
653 submenu_stack[submenu_depth++] = save_wv;
654 save_wv = prev_wv;
655 prev_wv = 0;
656 i++;
657 }
28be1ada 658 else if (EQ (AREF (menu_items, i), Qlambda))
279a1d4b
CY
659 {
660 prev_wv = save_wv;
661 save_wv = submenu_stack[--submenu_depth];
662 i++;
663 }
28be1ada 664 else if (EQ (AREF (menu_items, i), Qt)
279a1d4b
CY
665 && submenu_depth != 0)
666 i += MENU_ITEMS_PANE_LENGTH;
667 /* Ignore a nil in the item list.
668 It's meaningful only for dialog boxes. */
28be1ada 669 else if (EQ (AREF (menu_items, i), Qquote))
279a1d4b 670 i += 1;
28be1ada 671 else if (EQ (AREF (menu_items, i), Qt))
279a1d4b
CY
672 {
673 /* Create a new pane. */
b01a1c29 674 Lisp_Object pane_name;
675e2c69 675 const char *pane_string;
279a1d4b 676
7cded46f 677 panes_seen = 1;
279a1d4b 678
28be1ada 679 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
279a1d4b 680
06284c32
EZ
681 /* TTY menus display menu items via tty_write_glyphs, which
682 will encode the strings as appropriate. */
683 if (!FRAME_TERMCAP_P (f))
279a1d4b 684 {
06284c32
EZ
685#ifdef HAVE_NTGUI
686 if (STRINGP (pane_name))
687 {
688 if (unicode_append_menu)
689 /* Encode as UTF-8 for now. */
690 pane_name = ENCODE_UTF_8 (pane_name);
691 else if (STRING_MULTIBYTE (pane_name))
692 pane_name = ENCODE_SYSTEM (pane_name);
279a1d4b 693
06284c32
EZ
694 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
695 }
99852628 696#elif defined (USE_LUCID) && defined (HAVE_XFT)
06284c32
EZ
697 if (STRINGP (pane_name))
698 {
699 pane_name = ENCODE_UTF_8 (pane_name);
700 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
701 }
279a1d4b 702#elif !defined (HAVE_MULTILINGUAL_MENU)
06284c32
EZ
703 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
704 {
705 pane_name = ENCODE_MENU_STRING (pane_name);
706 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
707 }
279a1d4b 708#endif
06284c32 709 }
279a1d4b
CY
710
711 pane_string = (NILP (pane_name)
51b59d79 712 ? "" : SSDATA (pane_name));
279a1d4b
CY
713 /* If there is just one top-level pane, put all its items directly
714 under the top-level menu. */
715 if (menu_items_n_panes == 1)
716 pane_string = "";
717
718 /* If the pane has a meaningful name,
719 make the pane a top-level menu item
720 with its items as a submenu beneath it. */
721 if (strcmp (pane_string, ""))
722 {
723 wv = xmalloc_widget_value ();
724 if (save_wv)
725 save_wv->next = wv;
726 else
727 first_wv->contents = wv;
728 wv->lname = pane_name;
729 /* Set value to 1 so update_submenu_strings can handle '@' */
730 wv->value = (char *)1;
731 wv->enabled = 1;
732 wv->button_type = BUTTON_TYPE_NONE;
733 wv->help = Qnil;
734 save_wv = wv;
735 }
736 else
737 save_wv = first_wv;
738
739 prev_wv = 0;
740 i += MENU_ITEMS_PANE_LENGTH;
741 }
742 else
743 {
744 /* Create a new item within current pane. */
745 Lisp_Object item_name, enable, descrip, def, type, selected;
746 Lisp_Object help;
747
748 /* All items should be contained in panes. */
7cded46f 749 if (! panes_seen)
1088b922 750 emacs_abort ();
279a1d4b
CY
751
752 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
753 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
754 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
755 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
756 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
757 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
758 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
759
06284c32
EZ
760 /* TTY menu items and their descriptions will be encoded by
761 tty_write_glyphs. */
762 if (!FRAME_TERMCAP_P (f))
279a1d4b 763 {
06284c32
EZ
764#ifdef HAVE_NTGUI
765 if (STRINGP (item_name))
766 {
767 if (unicode_append_menu)
768 item_name = ENCODE_UTF_8 (item_name);
769 else if (STRING_MULTIBYTE (item_name))
770 item_name = ENCODE_SYSTEM (item_name);
279a1d4b 771
06284c32
EZ
772 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
773 }
279a1d4b 774
06284c32
EZ
775 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
776 {
777 descrip = ENCODE_SYSTEM (descrip);
778 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
779 }
99852628 780#elif USE_LUCID
06284c32
EZ
781 if (STRINGP (item_name))
782 {
783 item_name = ENCODE_UTF_8 (item_name);
784 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
785 }
99852628 786
06284c32
EZ
787 if (STRINGP (descrip))
788 {
789 descrip = ENCODE_UTF_8 (descrip);
790 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
791 }
279a1d4b 792#elif !defined (HAVE_MULTILINGUAL_MENU)
06284c32
EZ
793 if (STRING_MULTIBYTE (item_name))
794 {
795 item_name = ENCODE_MENU_STRING (item_name);
796 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
797 }
279a1d4b 798
06284c32
EZ
799 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
800 {
801 descrip = ENCODE_MENU_STRING (descrip);
802 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
803 }
279a1d4b 804#endif
06284c32 805 }
279a1d4b
CY
806
807 wv = xmalloc_widget_value ();
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;
816 wv->value = 0;
d01a7826 817 /* The intptr_t cast avoids a warning. There's no problem
279a1d4b 818 as long as pointers have enough bits to hold small integers. */
d01a7826 819 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
279a1d4b
CY
820 wv->enabled = !NILP (enable);
821
822 if (NILP (type))
823 wv->button_type = BUTTON_TYPE_NONE;
824 else if (EQ (type, QCradio))
825 wv->button_type = BUTTON_TYPE_RADIO;
826 else if (EQ (type, QCtoggle))
827 wv->button_type = BUTTON_TYPE_TOGGLE;
828 else
1088b922 829 emacs_abort ();
279a1d4b
CY
830
831 wv->selected = !NILP (selected);
832 if (! STRINGP (help))
833 help = Qnil;
834
835 wv->help = help;
836
837 prev_wv = wv;
838
839 i += MENU_ITEMS_ITEM_LENGTH;
840 }
841 }
842
843 /* If we have just one "menu item"
844 that was originally a button, return it by itself. */
845 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
846 {
847 wv = first_wv->contents;
848 free_widget_value (first_wv);
849 return wv;
850 }
851
852 return first_wv;
853}
854
855/* Walk through the widget_value tree starting at FIRST_WV and update
856 the char * pointers from the corresponding lisp values.
857 We do this after building the whole tree, since GC may happen while the
858 tree is constructed, and small strings are relocated. So we must wait
859 until no GC can happen before storing pointers into lisp values. */
860void
971de7fb 861update_submenu_strings (widget_value *first_wv)
279a1d4b
CY
862{
863 widget_value *wv;
864
865 for (wv = first_wv; wv; wv = wv->next)
866 {
867 if (STRINGP (wv->lname))
868 {
51b59d79 869 wv->name = SSDATA (wv->lname);
279a1d4b
CY
870
871 /* Ignore the @ that means "separate pane".
872 This is a kludge, but this isn't worth more time. */
873 if (wv->value == (char *)1)
874 {
875 if (wv->name[0] == '@')
876 wv->name++;
877 wv->value = 0;
878 }
879 }
880
881 if (STRINGP (wv->lkey))
51b59d79 882 wv->key = SSDATA (wv->lkey);
279a1d4b
CY
883
884 if (wv->contents)
885 update_submenu_strings (wv->contents);
886 }
887}
888
889/* Find the menu selection and store it in the keyboard buffer.
890 F is the frame the menu is on.
891 MENU_BAR_ITEMS_USED is the length of VECTOR.
892 VECTOR is an array of menu events for the whole menu. */
893
894void
a10c8269
DA
895find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
896 Lisp_Object vector, void *client_data)
279a1d4b
CY
897{
898 Lisp_Object prefix, entry;
899 Lisp_Object *subprefix_stack;
900 int submenu_depth = 0;
901 int i;
902
903 entry = Qnil;
38182d90 904 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
279a1d4b
CY
905 prefix = Qnil;
906 i = 0;
907
908 while (i < menu_bar_items_used)
909 {
28be1ada 910 if (EQ (AREF (vector, i), Qnil))
279a1d4b
CY
911 {
912 subprefix_stack[submenu_depth++] = prefix;
913 prefix = entry;
914 i++;
915 }
28be1ada 916 else if (EQ (AREF (vector, i), Qlambda))
279a1d4b
CY
917 {
918 prefix = subprefix_stack[--submenu_depth];
919 i++;
920 }
28be1ada 921 else if (EQ (AREF (vector, i), Qt))
279a1d4b 922 {
28be1ada 923 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
279a1d4b
CY
924 i += MENU_ITEMS_PANE_LENGTH;
925 }
926 else
927 {
28be1ada 928 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
8ac068ac 929 /* Treat the pointer as an integer. There's no problem
279a1d4b 930 as long as pointers have enough bits to hold small integers. */
d01a7826 931 if ((intptr_t) client_data == i)
279a1d4b
CY
932 {
933 int j;
934 struct input_event buf;
935 Lisp_Object frame;
936 EVENT_INIT (buf);
937
938 XSETFRAME (frame, f);
939 buf.kind = MENU_BAR_EVENT;
940 buf.frame_or_window = frame;
941 buf.arg = frame;
942 kbd_buffer_store_event (&buf);
943
944 for (j = 0; j < submenu_depth; j++)
945 if (!NILP (subprefix_stack[j]))
946 {
947 buf.kind = MENU_BAR_EVENT;
948 buf.frame_or_window = frame;
949 buf.arg = subprefix_stack[j];
950 kbd_buffer_store_event (&buf);
951 }
952
953 if (!NILP (prefix))
954 {
955 buf.kind = MENU_BAR_EVENT;
956 buf.frame_or_window = frame;
957 buf.arg = prefix;
958 kbd_buffer_store_event (&buf);
959 }
960
961 buf.kind = MENU_BAR_EVENT;
962 buf.frame_or_window = frame;
963 buf.arg = entry;
964 kbd_buffer_store_event (&buf);
965
966 return;
967 }
968 i += MENU_ITEMS_ITEM_LENGTH;
969 }
970 }
971}
972
edfda783
AR
973#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
974
975#ifdef HAVE_NS
976/* As above, but return the menu selection instead of storing in kb buffer.
7cded46f 977 If KEYMAPS, return full prefixes to selection. */
edfda783 978Lisp_Object
a10c8269 979find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
edfda783
AR
980{
981 Lisp_Object prefix, entry;
982 int i;
983 Lisp_Object *subprefix_stack;
984 int submenu_depth = 0;
985
986 prefix = entry = Qnil;
987 i = 0;
663e2b3f 988 subprefix_stack = alloca (menu_items_used * word_size);
edfda783
AR
989
990 while (i < menu_items_used)
991 {
28be1ada 992 if (EQ (AREF (menu_items, i), Qnil))
edfda783
AR
993 {
994 subprefix_stack[submenu_depth++] = prefix;
995 prefix = entry;
996 i++;
997 }
28be1ada 998 else if (EQ (AREF (menu_items, i), Qlambda))
edfda783
AR
999 {
1000 prefix = subprefix_stack[--submenu_depth];
1001 i++;
1002 }
28be1ada 1003 else if (EQ (AREF (menu_items, i), Qt))
edfda783
AR
1004 {
1005 prefix
28be1ada 1006 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
edfda783
AR
1007 i += MENU_ITEMS_PANE_LENGTH;
1008 }
1009 /* Ignore a nil in the item list.
1010 It's meaningful only for dialog boxes. */
28be1ada 1011 else if (EQ (AREF (menu_items, i), Qquote))
edfda783
AR
1012 i += 1;
1013 else
1014 {
1015 entry
28be1ada 1016 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
4939150c 1017 if (aref_addr (menu_items, i) == client_data)
edfda783 1018 {
7cded46f 1019 if (keymaps)
edfda783
AR
1020 {
1021 int j;
1022
6c6f1994 1023 entry = list1 (entry);
edfda783
AR
1024 if (!NILP (prefix))
1025 entry = Fcons (prefix, entry);
1026 for (j = submenu_depth - 1; j >= 0; j--)
1027 if (!NILP (subprefix_stack[j]))
1028 entry = Fcons (subprefix_stack[j], entry);
1029 }
1030 return entry;
1031 }
1032 i += MENU_ITEMS_ITEM_LENGTH;
1033 }
1034 }
facfbbbd 1035 return Qnil;
edfda783 1036}
31c2d412 1037#endif /* HAVE_NS */
279a1d4b 1038
3b158d11
PE
1039ptrdiff_t
1040menu_item_width (const unsigned char *str)
401cf890 1041{
3b158d11
PE
1042 ptrdiff_t len;
1043 const unsigned char *p;
401cf890
EZ
1044
1045 for (len = 0, p = str; *p; )
1046 {
1047 int ch_len;
1048 int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
1049
1050 len += CHAR_WIDTH (ch);
1051 p += ch_len;
1052 }
1053 return len;
1054}
1055
63dfbda7
EZ
1056DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y,
1057 2, 3, 0,
1058 doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y.
1059X and Y are frame-relative pixel coordinates, assumed to define
1060a location within the menu bar.
1061If FRAME is nil or omitted, it defaults to the selected frame.
1062
1063Value is the symbol of the menu at X/Y, or nil if the specified
1064coordinates are not within the FRAME's menu bar. The symbol can
1065be used to look up the menu like this:
1066
493a1978
EZ
1067 (lookup-key MAP [menu-bar SYMBOL])
1068
1069where MAP is either the current global map or the current local map,
1070since menu-bar items come from both.
63dfbda7
EZ
1071
1072This function can return non-nil only on a text-terminal frame
1073or on an X frame that doesn't use any GUI toolkit. Otherwise,
1074Emacs does not manage the menu bar and cannot convert coordinates
1075into menu items. */)
1076 (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
1077{
1078 int row, col;
1079 struct frame *f = decode_any_frame (frame);
1080
1081 if (!FRAME_LIVE_P (f))
1082 return Qnil;
1083
1084 pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1);
1085 if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
1086 {
1087 Lisp_Object items, item;
1088 int i;
1089
1090 /* Find the menu bar item under `col'. */
1091 item = Qnil;
1092 items = FRAME_MENU_BAR_ITEMS (f);
f9e5cb0a
EZ
1093 /* This loop assumes a single menu-bar line, and will fail to
1094 find an item if it is not in the first line. Note that
1095 make_lispy_event in keyboard.c makes the same assumption. */
63dfbda7
EZ
1096 for (i = 0; i < ASIZE (items); i += 4)
1097 {
1098 Lisp_Object pos, str;
1099
1100 str = AREF (items, i + 1);
1101 pos = AREF (items, i + 3);
1102 if (NILP (str))
1103 return item;
401cf890
EZ
1104 if (XINT (pos) <= col
1105 /* We use <= so the blank between 2 items on a TTY is
1106 considered part of the previous item. */
3b158d11 1107 && col <= XINT (pos) + menu_item_width (SDATA (str)))
63dfbda7
EZ
1108 {
1109 item = AREF (items, i);
1110 return item;
1111 }
1112 }
1113 }
1114 return Qnil;
1115}
1116
1117
a7ca3326 1118DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
ef7417fd
SM
1119 doc: /* Pop up a deck-of-cards menu and return user's selection.
1120POSITION is a position specification. This is either a mouse button event
1121or a list ((XOFFSET YOFFSET) WINDOW)
1122where XOFFSET and YOFFSET are positions in pixels from the top left
1123corner of WINDOW. (WINDOW may be a window or a frame object.)
1124This controls the position of the top left of the menu as a whole.
1125If POSITION is t, it means to use the current mouse position.
1126
1127MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1128The menu items come from key bindings that have a menu string as well as
1129a definition; actually, the "definition" in such a key binding looks like
1130\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1131the keymap as a top-level element.
1132
1133If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1134Otherwise, REAL-DEFINITION should be a valid key binding definition.
1135
1136You can also use a list of keymaps as MENU.
1137 Then each keymap makes a separate pane.
1138
1139When MENU is a keymap or a list of keymaps, the return value is the
1140list of events corresponding to the user's choice. Note that
1141`x-popup-menu' does not actually execute the command bound to that
1142sequence of events.
1143
1144Alternatively, you can specify a menu of multiple panes
1145 with a list of the form (TITLE PANE1 PANE2...),
1146where each pane is a list of form (TITLE ITEM1 ITEM2...).
1147Each ITEM is normally a cons cell (STRING . VALUE);
1148but a string can appear as an item--that makes a nonselectable line
1149in the menu.
1150With this form of menu, the return value is VALUE from the chosen item.
1151
1152If POSITION is nil, don't display the menu at all, just precalculate the
1153cached information about equivalent key sequences.
1154
1155If the user gets rid of the menu without making a valid choice, for
1156instance by clicking the mouse away from a valid choice or by typing
1157keyboard input, then this normally results in a quit and
1158`x-popup-menu' does not return. But if POSITION is a mouse button
1159event (indicating that the user invoked the menu with the mouse) then
1160no quit occurs and `x-popup-menu' returns nil. */)
5842a27b 1161 (Lisp_Object position, Lisp_Object menu)
ef7417fd 1162{
4a48e94d 1163 Lisp_Object keymap, tem, tem2;
ef7417fd
SM
1164 int xpos = 0, ypos = 0;
1165 Lisp_Object title;
42ca4633 1166 const char *error_name = NULL;
ef7417fd 1167 Lisp_Object selection = Qnil;
a10c8269 1168 struct frame *f = NULL;
ef7417fd 1169 Lisp_Object x, y, window;
7cded46f
PE
1170 bool keymaps = 0;
1171 bool for_click = 0;
4a48e94d 1172 bool kbd_menu_navigation = 0;
d311d28c 1173 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
ef7417fd 1174 struct gcpro gcpro1;
ef7417fd 1175
ef7417fd
SM
1176 if (NILP (position))
1177 /* This is an obsolete call, which wants us to precompute the
1178 keybinding equivalents, but we don't do that any more anyway. */
1179 return Qnil;
1180
1181#ifdef HAVE_MENUS
1182 {
7cded46f 1183 bool get_current_pos_p = 0;
73931ad1 1184
ef7417fd
SM
1185 /* Decode the first argument: find the window and the coordinates. */
1186 if (EQ (position, Qt)
1187 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1188 || EQ (XCAR (position), Qtool_bar))))
1189 {
1190 get_current_pos_p = 1;
1191 }
1192 else
1193 {
1194 tem = Fcar (position);
1195 if (CONSP (tem))
1196 {
1197 window = Fcar (Fcdr (position));
1198 x = XCAR (tem);
1199 y = Fcar (XCDR (tem));
1200 }
1201 else
1202 {
1203 for_click = 1;
1204 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1205 window = Fcar (tem); /* POSN_WINDOW (tem) */
4a48e94d
EZ
1206 tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */
1207 /* The kbd_menu_navigation flag is set when the menu was
1208 invoked by F10, which probably means they have no
1209 mouse. In that case, we let them switch between
1210 top-level menu-bar menus by using C-f/C-b and
1211 horizontal arrow keys, since they cannot click the
1212 mouse to open a different submenu. This flag is only
1213 supported by tty_menu_show. We set it when POSITION
1214 and last_nonmenu_event are different, which means we
1215 constructed POSITION by hand (in popup-menu, see
1216 menu-bar.el) to look like a mouse click on the menu bar
1217 event. */
1218 if (!EQ (POSN_POSN (last_nonmenu_event),
1219 POSN_POSN (position))
1220 && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar))
1221 kbd_menu_navigation = 1;
a6d676d9
CY
1222 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1223 x = Fcar (tem);
1224 y = Fcdr (tem);
ef7417fd
SM
1225 }
1226
1227 /* If a click happens in an external tool bar or a detached
1228 tool bar, x and y is NIL. In that case, use the current
1229 mouse position. This happens for the help button in the
1230 tool bar. Ideally popup-menu should pass NIL to
1231 this function, but it doesn't. */
1232 if (NILP (x) && NILP (y))
1233 get_current_pos_p = 1;
1234 }
1235
1236 if (get_current_pos_p)
1237 {
1238 /* Use the mouse's current position. */
a10c8269 1239 struct frame *new_f = SELECTED_FRAME ();
ef7417fd
SM
1240#ifdef HAVE_X_WINDOWS
1241 /* Can't use mouse_position_hook for X since it returns
1242 coordinates relative to the window the mouse is in,
1243 we need coordinates relative to the edit widget always. */
1244 if (new_f != 0)
1245 {
1246 int cur_x, cur_y;
1247
1248 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1249 /* cur_x/y may be negative, so use make_number. */
1250 x = make_number (cur_x);
1251 y = make_number (cur_y);
1252 }
1253
1254#else /* not HAVE_X_WINDOWS */
1255 Lisp_Object bar_window;
1256 enum scroll_bar_part part;
08dc5ae6 1257 Time time;
f57e2426
J
1258 void (*mouse_position_hook) (struct frame **, int,
1259 Lisp_Object *,
1260 enum scroll_bar_part *,
1261 Lisp_Object *,
1262 Lisp_Object *,
08dc5ae6 1263 Time *) =
ef7417fd
SM
1264 FRAME_TERMINAL (new_f)->mouse_position_hook;
1265
1266 if (mouse_position_hook)
1267 (*mouse_position_hook) (&new_f, 1, &bar_window,
1268 &part, &x, &y, &time);
1269#endif /* not HAVE_X_WINDOWS */
1270
1271 if (new_f != 0)
1272 XSETFRAME (window, new_f);
1273 else
1274 {
1275 window = selected_window;
1276 XSETFASTINT (x, 0);
1277 XSETFASTINT (y, 0);
1278 }
1279 }
1280
ef7417fd
SM
1281 /* Decode where to put the menu. */
1282
1283 if (FRAMEP (window))
1284 {
1285 f = XFRAME (window);
1286 xpos = 0;
1287 ypos = 0;
1288 }
1289 else if (WINDOWP (window))
1290 {
1291 struct window *win = XWINDOW (window);
1292 CHECK_LIVE_WINDOW (window);
1293 f = XFRAME (WINDOW_FRAME (win));
1294
ef7417fd
SM
1295 xpos = WINDOW_LEFT_EDGE_X (win);
1296 ypos = WINDOW_TOP_EDGE_Y (win);
ef7417fd
SM
1297 }
1298 else
1299 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1300 but I don't want to make one now. */
1301 CHECK_WINDOW (window);
1302
af5a5a98
AS
1303 CHECK_RANGED_INTEGER (x,
1304 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
d311d28c
PE
1305 ? (EMACS_INT) INT_MIN - xpos
1306 : MOST_NEGATIVE_FIXNUM),
af5a5a98
AS
1307 INT_MAX - xpos);
1308 CHECK_RANGED_INTEGER (y,
1309 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
d311d28c
PE
1310 ? (EMACS_INT) INT_MIN - ypos
1311 : MOST_NEGATIVE_FIXNUM),
af5a5a98 1312 INT_MAX - ypos);
ef7417fd
SM
1313 xpos += XINT (x);
1314 ypos += XINT (y);
1315
ef7417fd
SM
1316 XSETFRAME (Vmenu_updating_frame, f);
1317 }
1318#endif /* HAVE_MENUS */
1319
1320 /* Now parse the lisp menus. */
27e498e6 1321 record_unwind_protect_void (unuse_menu_items);
ef7417fd
SM
1322
1323 title = Qnil;
1324 GCPRO1 (title);
1325
1326 /* Decode the menu items from what was specified. */
1327
1328 keymap = get_keymap (menu, 0, 0);
1329 if (CONSP (keymap))
1330 {
1331 /* We were given a keymap. Extract menu info from the keymap. */
1332 Lisp_Object prompt;
1333
1334 /* Extract the detailed info to make one pane. */
1335 keymap_panes (&menu, 1);
1336
1337 /* Search for a string appearing directly as an element of the keymap.
1338 That string is the title of the menu. */
1339 prompt = Fkeymap_prompt (keymap);
1340 if (!NILP (prompt))
1341 title = prompt;
1342#ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1343 else
1344 title = build_string ("Select");
1345#endif
1346
1347 /* Make that be the pane title of the first pane. */
1348 if (!NILP (prompt) && menu_items_n_panes >= 0)
1349 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1350
1351 keymaps = 1;
1352 }
1353 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1354 {
1355 /* We were given a list of keymaps. */
d311d28c
PE
1356 EMACS_INT nmaps = XFASTINT (Flength (menu));
1357 Lisp_Object *maps;
1358 ptrdiff_t i;
1359 USE_SAFE_ALLOCA;
ef7417fd 1360
d311d28c 1361 SAFE_ALLOCA_LISP (maps, nmaps);
ef7417fd
SM
1362 title = Qnil;
1363
1364 /* The first keymap that has a prompt string
1365 supplies the menu title. */
1366 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1367 {
1368 Lisp_Object prompt;
1369
1370 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1371
1372 prompt = Fkeymap_prompt (keymap);
1373 if (NILP (title) && !NILP (prompt))
1374 title = prompt;
1375 }
1376
1377 /* Extract the detailed info to make one pane. */
1378 keymap_panes (maps, nmaps);
1379
1380 /* Make the title be the pane title of the first pane. */
1381 if (!NILP (title) && menu_items_n_panes >= 0)
1382 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1383
1384 keymaps = 1;
d311d28c
PE
1385
1386 SAFE_FREE ();
ef7417fd
SM
1387 }
1388 else
1389 {
1390 /* We were given an old-fashioned menu. */
1391 title = Fcar (menu);
1392 CHECK_STRING (title);
1393
1394 list_of_panes (Fcdr (menu));
1395
1396 keymaps = 0;
1397 }
1398
1399 unbind_to (specpdl_count, Qnil);
1400
1401#ifdef HAVE_MENUS
dc92c039 1402#ifdef HAVE_WINDOW_SYSTEM
ef7417fd 1403 /* Hide a previous tip, if any. */
ffc3882f
EZ
1404 if (!FRAME_TERMCAP_P (f))
1405 Fx_hide_tip ();
dc92c039 1406#endif
ef7417fd
SM
1407
1408#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1409 /* If resources from a previous popup menu still exist, does nothing
1410 until the `menu_free_timer' has freed them (see w32fns.c). This
1411 can occur if you press ESC or click outside a menu without selecting
1412 a menu item.
1413 */
ffc3882f 1414 if (current_popup_menu && FRAME_W32_P (f))
ef7417fd
SM
1415 {
1416 discard_menu_items ();
aad3612f 1417 FRAME_DISPLAY_INFO (f)->grabbed = 0;
ef7417fd
SM
1418 UNGCPRO;
1419 return Qnil;
1420 }
1421#endif
1422
1423#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
27e498e6 1424 record_unwind_protect_void (discard_menu_items);
ef7417fd
SM
1425#endif
1426
1427 /* Display them in a menu. */
ef7417fd
SM
1428
1429 /* FIXME: Use a terminal hook! */
1430#if defined HAVE_NTGUI
b5e9cbb6
EZ
1431 if (FRAME_W32_P (f))
1432 selection = w32_menu_show (f, xpos, ypos, for_click,
1433 keymaps, title, &error_name);
1434 else
1435#endif
1436#if defined HAVE_NS
1437 if (FRAME_NS_P (f))
1438 selection = ns_menu_show (f, xpos, ypos, for_click,
1439 keymaps, title, &error_name);
1440 else
1441#endif
1442#if (defined (HAVE_X_WINDOWS) || defined (MSDOS))
b5e9cbb6
EZ
1443 if (FRAME_X_P (f) || FRAME_MSDOS_P (f))
1444 selection = xmenu_show (f, xpos, ypos, for_click,
6bbe6da8 1445 keymaps, title, &error_name);
b5e9cbb6 1446 else
ef7417fd 1447#endif
b5e9cbb6 1448 if (FRAME_TERMCAP_P (f))
4a48e94d
EZ
1449 selection = tty_menu_show (f, xpos, ypos, for_click, keymaps, title,
1450 kbd_menu_navigation, &error_name);
ef7417fd 1451
ef7417fd
SM
1452#ifdef HAVE_NS
1453 unbind_to (specpdl_count, Qnil);
1454#else
1455 discard_menu_items ();
1456#endif
1457
1458#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
ffc3882f 1459 if (FRAME_W32_P (f))
b87c4ff2 1460 FRAME_DISPLAY_INFO (f)->grabbed = 0;
ef7417fd
SM
1461#endif
1462
1463#endif /* HAVE_MENUS */
1464
1465 UNGCPRO;
1466
42eea0d0 1467 if (error_name) error ("%s", error_name);
ef7417fd
SM
1468 return selection;
1469}
1470
0afa0aab
EZ
1471#ifdef HAVE_MENUS
1472
1473DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
1474 doc: /* Pop up a dialog box and return user's selection.
1475POSITION specifies which frame to use.
1476This is normally a mouse button event or a window or frame.
1477If POSITION is t, it means to use the frame the mouse is on.
1478The dialog box appears in the middle of the specified frame.
1479
1480CONTENTS specifies the alternatives to display in the dialog box.
1481It is a list of the form (DIALOG ITEM1 ITEM2...).
1482Each ITEM is a cons cell (STRING . VALUE).
1483The return value is VALUE from the chosen item.
1484
1485An ITEM may also be just a string--that makes a nonselectable item.
1486An ITEM may also be nil--that means to put all preceding items
1487on the left of the dialog box and all following items on the right.
1488\(By default, approximately half appear on each side.)
1489
1490If HEADER is non-nil, the frame title for the box is "Information",
1491otherwise it is "Question".
1492
1493If the user gets rid of the dialog box without making a valid choice,
1494for instance using the window manager, then this produces a quit and
1495`x-popup-dialog' does not return. */)
1496 (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
1497{
1498 struct frame *f = NULL;
1499 Lisp_Object window;
1500
1501 /* Decode the first argument: find the window or frame to use. */
1502 if (EQ (position, Qt)
1503 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1504 || EQ (XCAR (position), Qtool_bar))))
1505 {
1506#if 0 /* Using the frame the mouse is on may not be right. */
1507 /* Use the mouse's current position. */
1508 struct frame *new_f = SELECTED_FRAME ();
1509 Lisp_Object bar_window;
1510 enum scroll_bar_part part;
1511 Time time;
1512 Lisp_Object x, y;
1513
1514 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1515
1516 if (new_f != 0)
1517 XSETFRAME (window, new_f);
1518 else
1519 window = selected_window;
1520#endif
1521 window = selected_window;
1522 }
1523 else if (CONSP (position))
1524 {
1525 Lisp_Object tem = XCAR (position);
1526 if (CONSP (tem))
1527 window = Fcar (XCDR (position));
1528 else
1529 {
1530 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
1531 window = Fcar (tem); /* POSN_WINDOW (tem) */
1532 }
1533 }
1534 else if (WINDOWP (position) || FRAMEP (position))
1535 window = position;
1536 else
1537 window = Qnil;
1538
1539 /* Decode where to put the menu. */
1540
1541 if (FRAMEP (window))
1542 f = XFRAME (window);
1543 else if (WINDOWP (window))
1544 {
1545 CHECK_LIVE_WINDOW (window);
1546 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1547 }
1548 else
1549 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1550 but I don't want to make one now. */
1551 CHECK_WINDOW (window);
1552
1553 /* Force a redisplay before showing the dialog. If a frame is created
1554 just before showing the dialog, its contents may not have been fully
1555 drawn, as this depends on timing of events from the X server. Redisplay
1556 is not done when a dialog is shown. If redisplay could be done in the
1557 X event loop (i.e. the X event loop does not run in a signal handler)
1558 this would not be needed.
1559
1560 Do this before creating the widget value that points to Lisp
1561 string contents, because Fredisplay may GC and relocate them. */
1562 Fredisplay (Qt);
1563#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1564 if (FRAME_WINDOW_P (f))
1565 return xw_popup_dialog (f, header, contents);
1566 else
1567#endif
1568#if defined (HAVE_NTGUI) && defined (HAVE_DIALOGS)
1569 if (FRAME_W32_P (f))
1570 return w32_popup_dialog (f, header, contents);
1571 else
1572#endif
1573#ifdef HAVE_NS
1574 if (FRAME_NS_P (f))
1575 return ns_popup_dialog (position, header, contents);
1576 else
1577#endif
1578 /* Display a menu with these alternatives
1579 in the middle of frame F. */
1580 {
bdaed46f
EZ
1581 Lisp_Object x, y, frame, newpos, prompt;
1582 int x_coord, y_coord;
0afa0aab 1583
bdaed46f 1584 prompt = Fcar (contents);
0afa0aab
EZ
1585 if (FRAME_WINDOW_P (f))
1586 {
bdaed46f
EZ
1587 x_coord = FRAME_PIXEL_WIDTH (f);
1588 y_coord = FRAME_PIXEL_HEIGHT (f);
0afa0aab
EZ
1589 }
1590 else
1591 {
bdaed46f
EZ
1592 x_coord = FRAME_COLS (f);
1593 /* Center the title at frame middle. (TTY menus have their
1594 upper-left corner at the given position.) */
1595 if (STRINGP (prompt))
1596 x_coord -= SCHARS (prompt);
1597 y_coord = FRAME_LINES (f);
0afa0aab
EZ
1598 }
1599 XSETFRAME (frame, f);
bdaed46f
EZ
1600 XSETINT (x, x_coord / 2);
1601 XSETINT (y, y_coord / 2);
0afa0aab
EZ
1602 newpos = list2 (list2 (x, y), frame);
1603
bdaed46f 1604 return Fx_popup_menu (newpos, list2 (prompt, contents));
0afa0aab
EZ
1605 }
1606}
1607
1608#endif /* HAVE_MENUS */
1609
279a1d4b 1610void
971de7fb 1611syms_of_menu (void)
279a1d4b
CY
1612{
1613 staticpro (&menu_items);
1614 menu_items = Qnil;
1615 menu_items_inuse = Qnil;
ef7417fd
SM
1616
1617 defsubr (&Sx_popup_menu);
0afa0aab
EZ
1618
1619#ifdef HAVE_MENUS
1620 defsubr (&Sx_popup_dialog);
1621#endif
63dfbda7 1622 defsubr (&Smenu_bar_menu_at_x_y);
279a1d4b 1623}