Provisional fix for bug #16479 with client connecting while in a TTY menu.
[bpt/emacs.git] / src / menu.c
CommitLineData
279a1d4b 1/* Platform-independent code for terminal communications.
95df8112 2
ba318903 3Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2014 Free Software
ab422c4d 4Foundation, Inc.
279a1d4b
CY
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software: you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation, either version 3 of the License, or
11(at your option) any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21#include <config.h>
22#include <stdio.h>
3c24731f 23#include <limits.h> /* for INT_MAX */
279a1d4b
CY
24
25#include "lisp.h"
26#include "keyboard.h"
27#include "keymap.h"
28#include "frame.h"
ef7417fd 29#include "window.h"
279a1d4b
CY
30#include "termhooks.h"
31#include "blockinput.h"
32#include "dispextern.h"
401cf890 33#include "buffer.h"
279a1d4b
CY
34
35#ifdef USE_X_TOOLKIT
36#include "../lwlib/lwlib.h"
37#endif
38
17a2cbbd
DC
39#ifdef HAVE_WINDOW_SYSTEM
40#include TERM_HEADER
41#endif /* HAVE_WINDOW_SYSTEM */
279a1d4b
CY
42
43#ifdef HAVE_NTGUI
0fda9b75
DC
44# ifdef NTGUI_UNICODE
45# define unicode_append_menu AppendMenuW
46# else /* !NTGUI_UNICODE */
279a1d4b 47extern AppendMenuW_Proc unicode_append_menu;
0fda9b75 48# endif /* NTGUI_UNICODE */
04e452cb 49extern HMENU current_popup_menu;
279a1d4b
CY
50#endif /* HAVE_NTGUI */
51
e7c9048f 52#include "menu.h"
279a1d4b 53
f1303b52
EZ
54/* Return non-zero if menus can handle radio and toggle buttons. */
55static bool
56have_boxes (void)
57{
b911a94d 58#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined(HAVE_NS)
f1303b52
EZ
59 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)))
60 return 1;
279a1d4b 61#endif
f1303b52
EZ
62 return 0;
63}
279a1d4b 64
279a1d4b
CY
65Lisp_Object menu_items;
66
67/* If non-nil, means that the global vars defined here are already in use.
68 Used to detect cases where we try to re-enter this non-reentrant code. */
4475bec4
PE
69#if ! (defined USE_GTK || defined USE_MOTIF)
70static
71#endif
279a1d4b
CY
72Lisp_Object menu_items_inuse;
73
74/* Number of slots currently allocated in menu_items. */
75int menu_items_allocated;
76
77/* This is the index in menu_items of the first empty slot. */
78int menu_items_used;
79
80/* The number of panes currently recorded in menu_items,
81 excluding those within submenus. */
82int menu_items_n_panes;
83
84/* Current depth within submenus. */
85static int menu_items_submenu_depth;
86
87void
971de7fb 88init_menu_items (void)
279a1d4b
CY
89{
90 if (!NILP (menu_items_inuse))
91 error ("Trying to use a menu from within a menu-entry");
92
93 if (NILP (menu_items))
94 {
95 menu_items_allocated = 60;
96 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
97 }
98
99 menu_items_inuse = Qt;
100 menu_items_used = 0;
101 menu_items_n_panes = 0;
102 menu_items_submenu_depth = 0;
103}
104
105/* Call at the end of generating the data in menu_items. */
106
107void
971de7fb 108finish_menu_items (void)
279a1d4b
CY
109{
110}
111
27e498e6
PE
112void
113unuse_menu_items (void)
279a1d4b 114{
27e498e6 115 menu_items_inuse = Qnil;
279a1d4b
CY
116}
117
118/* Call when finished using the data for the current menu
119 in menu_items. */
120
121void
971de7fb 122discard_menu_items (void)
279a1d4b
CY
123{
124 /* Free the structure if it is especially large.
125 Otherwise, hold on to it, to save time. */
126 if (menu_items_allocated > 200)
127 {
128 menu_items = Qnil;
129 menu_items_allocated = 0;
130 }
a54e2c05 131 eassert (NILP (menu_items_inuse));
279a1d4b
CY
132}
133
134/* This undoes save_menu_items, and it is called by the specpdl unwind
135 mechanism. */
136
27e498e6 137static void
971de7fb 138restore_menu_items (Lisp_Object saved)
279a1d4b
CY
139{
140 menu_items = XCAR (saved);
141 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
142 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
143 saved = XCDR (saved);
144 menu_items_used = XINT (XCAR (saved));
145 saved = XCDR (saved);
146 menu_items_n_panes = XINT (XCAR (saved));
147 saved = XCDR (saved);
148 menu_items_submenu_depth = XINT (XCAR (saved));
279a1d4b
CY
149}
150
151/* Push the whole state of menu_items processing onto the specpdl.
152 It will be restored when the specpdl is unwound. */
153
154void
971de7fb 155save_menu_items (void)
279a1d4b
CY
156{
157 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
158 make_number (menu_items_used),
159 make_number (menu_items_n_panes),
160 make_number (menu_items_submenu_depth));
161 record_unwind_protect (restore_menu_items, saved);
162 menu_items_inuse = Qnil;
163 menu_items = Qnil;
164}
165
166\f
d311d28c 167/* Ensure that there is room for ITEMS items in the menu_items vector. */
279a1d4b
CY
168
169static void
d311d28c 170ensure_menu_items (int items)
279a1d4b 171{
d311d28c 172 int incr = items - (menu_items_allocated - menu_items_used);
908589fd 173 if (incr > 0)
d311d28c
PE
174 {
175 menu_items = larger_vector (menu_items, incr, INT_MAX);
176 menu_items_allocated = ASIZE (menu_items);
177 }
279a1d4b
CY
178}
179
60d9e1db
PE
180#if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
181 || defined HAVE_NTGUI)
182
279a1d4b
CY
183/* Begin a submenu. */
184
185static void
971de7fb 186push_submenu_start (void)
279a1d4b 187{
d311d28c 188 ensure_menu_items (1);
fb7da12e
AS
189 ASET (menu_items, menu_items_used, Qnil);
190 menu_items_used++;
279a1d4b
CY
191 menu_items_submenu_depth++;
192}
193
194/* End a submenu. */
195
196static void
971de7fb 197push_submenu_end (void)
279a1d4b 198{
d311d28c 199 ensure_menu_items (1);
fb7da12e
AS
200 ASET (menu_items, menu_items_used, Qlambda);
201 menu_items_used++;
279a1d4b
CY
202 menu_items_submenu_depth--;
203}
204
60d9e1db
PE
205#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
206
279a1d4b
CY
207/* Indicate boundary between left and right. */
208
209static void
971de7fb 210push_left_right_boundary (void)
279a1d4b 211{
d311d28c 212 ensure_menu_items (1);
fb7da12e
AS
213 ASET (menu_items, menu_items_used, Qquote);
214 menu_items_used++;
279a1d4b
CY
215}
216
217/* Start a new menu pane in menu_items.
218 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
219
593c843c 220static void
971de7fb 221push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
279a1d4b 222{
d311d28c 223 ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
279a1d4b
CY
224 if (menu_items_submenu_depth == 0)
225 menu_items_n_panes++;
fb7da12e
AS
226 ASET (menu_items, menu_items_used, Qt);
227 menu_items_used++;
228 ASET (menu_items, menu_items_used, name);
229 menu_items_used++;
230 ASET (menu_items, menu_items_used, prefix_vec);
231 menu_items_used++;
279a1d4b
CY
232}
233
234/* Push one menu item into the current pane. NAME is the string to
235 display. ENABLE if non-nil means this item can be selected. KEY
236 is the key generated by choosing this item, or nil if this item
237 doesn't really have a definition. DEF is the definition of this
238 item. EQUIV is the textual description of the keyboard equivalent
239 for this item (or nil if none). TYPE is the type of this menu
240 item, one of nil, `toggle' or `radio'. */
241
593c843c 242static void
971de7fb 243push_menu_item (Lisp_Object name, Lisp_Object enable, Lisp_Object key, Lisp_Object def, Lisp_Object equiv, Lisp_Object type, Lisp_Object selected, Lisp_Object help)
279a1d4b 244{
d311d28c 245 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
279a1d4b 246
b7c7a4d1
SM
247 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
248 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
249 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
250 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
252 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
253 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
254 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
255
256 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
279a1d4b
CY
257}
258
259/* Args passed between single_keymap_panes and single_menu_item. */
260struct skp
261 {
262 Lisp_Object pending_maps;
ef7417fd 263 int maxdepth;
279a1d4b
CY
264 int notbuttons;
265 };
266
f57e2426
J
267static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
268 void *);
279a1d4b
CY
269
270/* This is a recursive subroutine of keymap_panes.
271 It handles one keymap, KEYMAP.
272 The other arguments are passed along
273 or point to local variables of the previous function.
279a1d4b
CY
274
275 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
276
593c843c 277static void
ef7417fd
SM
278single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
279 Lisp_Object prefix, int maxdepth)
279a1d4b
CY
280{
281 struct skp skp;
282 struct gcpro gcpro1;
283
284 skp.pending_maps = Qnil;
285 skp.maxdepth = maxdepth;
279a1d4b
CY
286 skp.notbuttons = 0;
287
288 if (maxdepth <= 0)
289 return;
290
291 push_menu_pane (pane_name, prefix);
292
f1303b52
EZ
293 if (!have_boxes ())
294 {
295 /* Remember index for first item in this pane so we can go back
296 and add a prefix when (if) we see the first button. After
297 that, notbuttons is set to 0, to mark that we have seen a
298 button and all non button items need a prefix. */
299 skp.notbuttons = menu_items_used;
300 }
279a1d4b
CY
301
302 GCPRO1 (skp.pending_maps);
303 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
304 UNGCPRO;
305
306 /* Process now any submenus which want to be panes at this level. */
307 while (CONSP (skp.pending_maps))
308 {
309 Lisp_Object elt, eltcdr, string;
310 elt = XCAR (skp.pending_maps);
311 eltcdr = XCDR (elt);
312 string = XCAR (eltcdr);
313 /* We no longer discard the @ from the beginning of the string here.
314 Instead, we do this in *menu_show. */
ef7417fd 315 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
279a1d4b
CY
316 skp.pending_maps = XCDR (skp.pending_maps);
317 }
318}
319
320/* This is a subroutine of single_keymap_panes that handles one
321 keymap entry.
322 KEY is a key in a keymap and ITEM is its binding.
323 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
324 separate panes.
279a1d4b
CY
325 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
326
327static void
971de7fb 328single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
279a1d4b
CY
329{
330 Lisp_Object map, item_string, enabled;
331 struct gcpro gcpro1, gcpro2;
9fa1de30 332 bool res;
279a1d4b
CY
333 struct skp *skp = skp_v;
334
335 /* Parse the menu item and leave the result in item_properties. */
336 GCPRO2 (key, item);
ef7417fd 337 res = parse_menu_item (item, 0);
279a1d4b
CY
338 UNGCPRO;
339 if (!res)
340 return; /* Not a menu item. */
341
28be1ada 342 map = AREF (item_properties, ITEM_PROPERTY_MAP);
279a1d4b 343
28be1ada
DA
344 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
345 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
279a1d4b
CY
346
347 if (!NILP (map) && SREF (item_string, 0) == '@')
348 {
349 if (!NILP (enabled))
350 /* An enabled separate pane. Remember this to handle it later. */
351 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
352 skp->pending_maps);
353 return;
354 }
355
279a1d4b
CY
356 /* Simulate radio buttons and toggle boxes by putting a prefix in
357 front of them. */
f1303b52
EZ
358 if (!have_boxes ())
359 {
360 Lisp_Object prefix = Qnil;
361 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
362 if (!NILP (type))
363 {
364 Lisp_Object selected
365 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
366
367 if (skp->notbuttons)
368 /* The first button. Line up previous items in this menu. */
369 {
370 int idx = skp->notbuttons; /* Index for first item this menu. */
371 int submenu = 0;
372 Lisp_Object tem;
373 while (idx < menu_items_used)
374 {
375 tem
376 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
377 if (NILP (tem))
378 {
379 idx++;
380 submenu++; /* Skip sub menu. */
381 }
382 else if (EQ (tem, Qlambda))
383 {
384 idx++;
385 submenu--; /* End sub menu. */
386 }
387 else if (EQ (tem, Qt))
388 idx += 3; /* Skip new pane marker. */
389 else if (EQ (tem, Qquote))
390 idx++; /* Skip a left, right divider. */
391 else
392 {
393 if (!submenu && SREF (tem, 0) != '\0'
394 && SREF (tem, 0) != '-')
395 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
396 concat2 (build_string (" "), tem));
397 idx += MENU_ITEMS_ITEM_LENGTH;
398 }
399 }
400 skp->notbuttons = 0;
401 }
402
403 /* Calculate prefix, if any, for this item. */
404 if (EQ (type, QCtoggle))
405 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
406 else if (EQ (type, QCradio))
407 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
408 }
409 /* Not a button. If we have earlier buttons, then we need a prefix. */
410 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
411 && SREF (item_string, 0) != '-')
412 prefix = build_string (" ");
413
414 if (!NILP (prefix))
415 item_string = concat2 (prefix, item_string);
279a1d4b 416 }
279a1d4b 417
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
ef7417fd 1181 {
7cded46f 1182 bool get_current_pos_p = 0;
73931ad1 1183
ef7417fd
SM
1184 /* Decode the first argument: find the window and the coordinates. */
1185 if (EQ (position, Qt)
1186 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1187 || EQ (XCAR (position), Qtool_bar))))
1188 {
1189 get_current_pos_p = 1;
1190 }
1191 else
1192 {
1193 tem = Fcar (position);
1194 if (CONSP (tem))
1195 {
1196 window = Fcar (Fcdr (position));
1197 x = XCAR (tem);
1198 y = Fcar (XCDR (tem));
1199 }
1200 else
1201 {
1202 for_click = 1;
1203 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1204 window = Fcar (tem); /* POSN_WINDOW (tem) */
4a48e94d
EZ
1205 tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */
1206 /* The kbd_menu_navigation flag is set when the menu was
1207 invoked by F10, which probably means they have no
1208 mouse. In that case, we let them switch between
1209 top-level menu-bar menus by using C-f/C-b and
1210 horizontal arrow keys, since they cannot click the
1211 mouse to open a different submenu. This flag is only
1212 supported by tty_menu_show. We set it when POSITION
1213 and last_nonmenu_event are different, which means we
1214 constructed POSITION by hand (in popup-menu, see
1215 menu-bar.el) to look like a mouse click on the menu bar
1216 event. */
1217 if (!EQ (POSN_POSN (last_nonmenu_event),
1218 POSN_POSN (position))
1219 && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar))
1220 kbd_menu_navigation = 1;
a6d676d9
CY
1221 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1222 x = Fcar (tem);
1223 y = Fcdr (tem);
ef7417fd
SM
1224 }
1225
1226 /* If a click happens in an external tool bar or a detached
1227 tool bar, x and y is NIL. In that case, use the current
1228 mouse position. This happens for the help button in the
1229 tool bar. Ideally popup-menu should pass NIL to
1230 this function, but it doesn't. */
1231 if (NILP (x) && NILP (y))
1232 get_current_pos_p = 1;
1233 }
1234
1235 if (get_current_pos_p)
1236 {
1237 /* Use the mouse's current position. */
a10c8269 1238 struct frame *new_f = SELECTED_FRAME ();
ef7417fd
SM
1239#ifdef HAVE_X_WINDOWS
1240 /* Can't use mouse_position_hook for X since it returns
1241 coordinates relative to the window the mouse is in,
1242 we need coordinates relative to the edit widget always. */
1243 if (new_f != 0)
1244 {
1245 int cur_x, cur_y;
1246
1247 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1248 /* cur_x/y may be negative, so use make_number. */
1249 x = make_number (cur_x);
1250 y = make_number (cur_y);
1251 }
1252
1253#else /* not HAVE_X_WINDOWS */
1254 Lisp_Object bar_window;
1255 enum scroll_bar_part part;
08dc5ae6 1256 Time time;
f57e2426
J
1257 void (*mouse_position_hook) (struct frame **, int,
1258 Lisp_Object *,
1259 enum scroll_bar_part *,
1260 Lisp_Object *,
1261 Lisp_Object *,
08dc5ae6 1262 Time *) =
ef7417fd
SM
1263 FRAME_TERMINAL (new_f)->mouse_position_hook;
1264
1265 if (mouse_position_hook)
1266 (*mouse_position_hook) (&new_f, 1, &bar_window,
1267 &part, &x, &y, &time);
1268#endif /* not HAVE_X_WINDOWS */
1269
1270 if (new_f != 0)
1271 XSETFRAME (window, new_f);
1272 else
1273 {
1274 window = selected_window;
1275 XSETFASTINT (x, 0);
1276 XSETFASTINT (y, 0);
1277 }
1278 }
1279
ef7417fd
SM
1280 /* Decode where to put the menu. */
1281
1282 if (FRAMEP (window))
1283 {
1284 f = XFRAME (window);
1285 xpos = 0;
1286 ypos = 0;
1287 }
1288 else if (WINDOWP (window))
1289 {
1290 struct window *win = XWINDOW (window);
1291 CHECK_LIVE_WINDOW (window);
1292 f = XFRAME (WINDOW_FRAME (win));
1293
ef7417fd
SM
1294 xpos = WINDOW_LEFT_EDGE_X (win);
1295 ypos = WINDOW_TOP_EDGE_Y (win);
ef7417fd
SM
1296 }
1297 else
1298 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1299 but I don't want to make one now. */
1300 CHECK_WINDOW (window);
1301
af5a5a98
AS
1302 CHECK_RANGED_INTEGER (x,
1303 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
d311d28c
PE
1304 ? (EMACS_INT) INT_MIN - xpos
1305 : MOST_NEGATIVE_FIXNUM),
af5a5a98
AS
1306 INT_MAX - xpos);
1307 CHECK_RANGED_INTEGER (y,
1308 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
d311d28c
PE
1309 ? (EMACS_INT) INT_MIN - ypos
1310 : MOST_NEGATIVE_FIXNUM),
af5a5a98 1311 INT_MAX - ypos);
ef7417fd
SM
1312 xpos += XINT (x);
1313 ypos += XINT (y);
1314
ef7417fd
SM
1315 XSETFRAME (Vmenu_updating_frame, f);
1316 }
ef7417fd
SM
1317
1318 /* Now parse the lisp menus. */
27e498e6 1319 record_unwind_protect_void (unuse_menu_items);
ef7417fd
SM
1320
1321 title = Qnil;
1322 GCPRO1 (title);
1323
1324 /* Decode the menu items from what was specified. */
1325
1326 keymap = get_keymap (menu, 0, 0);
1327 if (CONSP (keymap))
1328 {
1329 /* We were given a keymap. Extract menu info from the keymap. */
1330 Lisp_Object prompt;
1331
1332 /* Extract the detailed info to make one pane. */
1333 keymap_panes (&menu, 1);
1334
1335 /* Search for a string appearing directly as an element of the keymap.
1336 That string is the title of the menu. */
1337 prompt = Fkeymap_prompt (keymap);
1338 if (!NILP (prompt))
1339 title = prompt;
1340#ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1341 else
1342 title = build_string ("Select");
1343#endif
1344
1345 /* Make that be the pane title of the first pane. */
1346 if (!NILP (prompt) && menu_items_n_panes >= 0)
1347 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1348
1349 keymaps = 1;
1350 }
1351 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1352 {
1353 /* We were given a list of keymaps. */
d311d28c
PE
1354 EMACS_INT nmaps = XFASTINT (Flength (menu));
1355 Lisp_Object *maps;
1356 ptrdiff_t i;
1357 USE_SAFE_ALLOCA;
ef7417fd 1358
d311d28c 1359 SAFE_ALLOCA_LISP (maps, nmaps);
ef7417fd
SM
1360 title = Qnil;
1361
1362 /* The first keymap that has a prompt string
1363 supplies the menu title. */
1364 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1365 {
1366 Lisp_Object prompt;
1367
1368 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1369
1370 prompt = Fkeymap_prompt (keymap);
1371 if (NILP (title) && !NILP (prompt))
1372 title = prompt;
1373 }
1374
1375 /* Extract the detailed info to make one pane. */
1376 keymap_panes (maps, nmaps);
1377
1378 /* Make the title be the pane title of the first pane. */
1379 if (!NILP (title) && menu_items_n_panes >= 0)
1380 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1381
1382 keymaps = 1;
d311d28c
PE
1383
1384 SAFE_FREE ();
ef7417fd
SM
1385 }
1386 else
1387 {
1388 /* We were given an old-fashioned menu. */
1389 title = Fcar (menu);
1390 CHECK_STRING (title);
1391
1392 list_of_panes (Fcdr (menu));
1393
1394 keymaps = 0;
1395 }
1396
1397 unbind_to (specpdl_count, Qnil);
1398
dc92c039 1399#ifdef HAVE_WINDOW_SYSTEM
ef7417fd 1400 /* Hide a previous tip, if any. */
ffc3882f
EZ
1401 if (!FRAME_TERMCAP_P (f))
1402 Fx_hide_tip ();
dc92c039 1403#endif
ef7417fd
SM
1404
1405#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1406 /* If resources from a previous popup menu still exist, does nothing
1407 until the `menu_free_timer' has freed them (see w32fns.c). This
1408 can occur if you press ESC or click outside a menu without selecting
1409 a menu item.
1410 */
ffc3882f 1411 if (current_popup_menu && FRAME_W32_P (f))
ef7417fd
SM
1412 {
1413 discard_menu_items ();
aad3612f 1414 FRAME_DISPLAY_INFO (f)->grabbed = 0;
ef7417fd
SM
1415 UNGCPRO;
1416 return Qnil;
1417 }
1418#endif
1419
1420#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
27e498e6 1421 record_unwind_protect_void (discard_menu_items);
ef7417fd
SM
1422#endif
1423
1424 /* Display them in a menu. */
ef7417fd
SM
1425
1426 /* FIXME: Use a terminal hook! */
1427#if defined HAVE_NTGUI
b5e9cbb6
EZ
1428 if (FRAME_W32_P (f))
1429 selection = w32_menu_show (f, xpos, ypos, for_click,
1430 keymaps, title, &error_name);
1431 else
1432#endif
1433#if defined HAVE_NS
1434 if (FRAME_NS_P (f))
1435 selection = ns_menu_show (f, xpos, ypos, for_click,
1436 keymaps, title, &error_name);
1437 else
1438#endif
1439#if (defined (HAVE_X_WINDOWS) || defined (MSDOS))
b5e9cbb6
EZ
1440 if (FRAME_X_P (f) || FRAME_MSDOS_P (f))
1441 selection = xmenu_show (f, xpos, ypos, for_click,
6bbe6da8 1442 keymaps, title, &error_name);
b5e9cbb6 1443 else
ef7417fd 1444#endif
b5e9cbb6 1445 if (FRAME_TERMCAP_P (f))
20adfbd8
EZ
1446 {
1447 ptrdiff_t count1 = SPECPDL_INDEX ();
1448
1449 /* Avoid crashes if, e.g., another client will connect while we
1450 are in a menu. */
1451 temporarily_switch_to_single_kboard (f);
1452 selection = tty_menu_show (f, xpos, ypos, for_click, keymaps, title,
1453 kbd_menu_navigation, &error_name);
1454 unbind_to (count1, Qnil);
1455 }
ef7417fd 1456
ef7417fd
SM
1457#ifdef HAVE_NS
1458 unbind_to (specpdl_count, Qnil);
1459#else
1460 discard_menu_items ();
1461#endif
1462
1463#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
ffc3882f 1464 if (FRAME_W32_P (f))
b87c4ff2 1465 FRAME_DISPLAY_INFO (f)->grabbed = 0;
ef7417fd
SM
1466#endif
1467
ef7417fd
SM
1468 UNGCPRO;
1469
42eea0d0 1470 if (error_name) error ("%s", error_name);
ef7417fd
SM
1471 return selection;
1472}
1473
0afa0aab
EZ
1474DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
1475 doc: /* Pop up a dialog box and return user's selection.
1476POSITION specifies which frame to use.
1477This is normally a mouse button event or a window or frame.
1478If POSITION is t, it means to use the frame the mouse is on.
1479The dialog box appears in the middle of the specified frame.
1480
1481CONTENTS specifies the alternatives to display in the dialog box.
1482It is a list of the form (DIALOG ITEM1 ITEM2...).
1483Each ITEM is a cons cell (STRING . VALUE).
1484The return value is VALUE from the chosen item.
1485
1486An ITEM may also be just a string--that makes a nonselectable item.
1487An ITEM may also be nil--that means to put all preceding items
1488on the left of the dialog box and all following items on the right.
1489\(By default, approximately half appear on each side.)
1490
1491If HEADER is non-nil, the frame title for the box is "Information",
1492otherwise it is "Question".
1493
1494If the user gets rid of the dialog box without making a valid choice,
1495for instance using the window manager, then this produces a quit and
1496`x-popup-dialog' does not return. */)
1497 (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
1498{
1499 struct frame *f = NULL;
1500 Lisp_Object window;
1501
1502 /* Decode the first argument: find the window or frame to use. */
1503 if (EQ (position, Qt)
1504 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1505 || EQ (XCAR (position), Qtool_bar))))
1506 {
1507#if 0 /* Using the frame the mouse is on may not be right. */
1508 /* Use the mouse's current position. */
1509 struct frame *new_f = SELECTED_FRAME ();
1510 Lisp_Object bar_window;
1511 enum scroll_bar_part part;
1512 Time time;
1513 Lisp_Object x, y;
1514
1515 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1516
1517 if (new_f != 0)
1518 XSETFRAME (window, new_f);
1519 else
1520 window = selected_window;
1521#endif
1522 window = selected_window;
1523 }
1524 else if (CONSP (position))
1525 {
1526 Lisp_Object tem = XCAR (position);
1527 if (CONSP (tem))
1528 window = Fcar (XCDR (position));
1529 else
1530 {
1531 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
1532 window = Fcar (tem); /* POSN_WINDOW (tem) */
1533 }
1534 }
1535 else if (WINDOWP (position) || FRAMEP (position))
1536 window = position;
1537 else
1538 window = Qnil;
1539
1540 /* Decode where to put the menu. */
1541
1542 if (FRAMEP (window))
1543 f = XFRAME (window);
1544 else if (WINDOWP (window))
1545 {
1546 CHECK_LIVE_WINDOW (window);
1547 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1548 }
1549 else
1550 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1551 but I don't want to make one now. */
1552 CHECK_WINDOW (window);
1553
1554 /* Force a redisplay before showing the dialog. If a frame is created
1555 just before showing the dialog, its contents may not have been fully
1556 drawn, as this depends on timing of events from the X server. Redisplay
1557 is not done when a dialog is shown. If redisplay could be done in the
1558 X event loop (i.e. the X event loop does not run in a signal handler)
1559 this would not be needed.
1560
1561 Do this before creating the widget value that points to Lisp
1562 string contents, because Fredisplay may GC and relocate them. */
1563 Fredisplay (Qt);
1564#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
1565 if (FRAME_WINDOW_P (f))
1566 return xw_popup_dialog (f, header, contents);
1567 else
1568#endif
1569#if defined (HAVE_NTGUI) && defined (HAVE_DIALOGS)
1570 if (FRAME_W32_P (f))
1571 return w32_popup_dialog (f, header, contents);
1572 else
1573#endif
1574#ifdef HAVE_NS
1575 if (FRAME_NS_P (f))
1576 return ns_popup_dialog (position, header, contents);
1577 else
1578#endif
1579 /* Display a menu with these alternatives
1580 in the middle of frame F. */
1581 {
bdaed46f
EZ
1582 Lisp_Object x, y, frame, newpos, prompt;
1583 int x_coord, y_coord;
0afa0aab 1584
bdaed46f 1585 prompt = Fcar (contents);
0afa0aab
EZ
1586 if (FRAME_WINDOW_P (f))
1587 {
bdaed46f
EZ
1588 x_coord = FRAME_PIXEL_WIDTH (f);
1589 y_coord = FRAME_PIXEL_HEIGHT (f);
0afa0aab
EZ
1590 }
1591 else
1592 {
bdaed46f
EZ
1593 x_coord = FRAME_COLS (f);
1594 /* Center the title at frame middle. (TTY menus have their
1595 upper-left corner at the given position.) */
1596 if (STRINGP (prompt))
1597 x_coord -= SCHARS (prompt);
1598 y_coord = FRAME_LINES (f);
0afa0aab
EZ
1599 }
1600 XSETFRAME (frame, f);
bdaed46f
EZ
1601 XSETINT (x, x_coord / 2);
1602 XSETINT (y, y_coord / 2);
0afa0aab
EZ
1603 newpos = list2 (list2 (x, y), frame);
1604
bdaed46f 1605 return Fx_popup_menu (newpos, list2 (prompt, contents));
0afa0aab
EZ
1606 }
1607}
1608
279a1d4b 1609void
971de7fb 1610syms_of_menu (void)
279a1d4b
CY
1611{
1612 staticpro (&menu_items);
1613 menu_items = Qnil;
1614 menu_items_inuse = Qnil;
ef7417fd
SM
1615
1616 defsubr (&Sx_popup_menu);
0afa0aab 1617 defsubr (&Sx_popup_dialog);
63dfbda7 1618 defsubr (&Smenu_bar_menu_at_x_y);
279a1d4b 1619}