* lisp.h (lispstpcpy): Rename from lispstrcpy, and act like stpcpy.
[emacs.git] / src / menu.c
blobea8da7a9d629073f615e08c55c4dd77f2e5c2e39
1 /* Platform-independent code for terminal communications.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2014 Free Software
4 Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
22 #include <stdio.h>
23 #include <limits.h> /* for INT_MAX */
25 #include "lisp.h"
26 #include "keyboard.h"
27 #include "keymap.h"
28 #include "frame.h"
29 #include "window.h"
30 #include "termhooks.h"
31 #include "blockinput.h"
32 #include "dispextern.h"
33 #include "buffer.h"
35 #ifdef USE_X_TOOLKIT
36 #include "../lwlib/lwlib.h"
37 #endif
39 #ifdef HAVE_WINDOW_SYSTEM
40 #include TERM_HEADER
41 #endif /* HAVE_WINDOW_SYSTEM */
43 #ifdef HAVE_NTGUI
44 # ifdef NTGUI_UNICODE
45 # define unicode_append_menu AppendMenuW
46 # else /* !NTGUI_UNICODE */
47 extern AppendMenuW_Proc unicode_append_menu;
48 # endif /* NTGUI_UNICODE */
49 extern HMENU current_popup_menu;
50 #endif /* HAVE_NTGUI */
52 #include "menu.h"
54 /* Return non-zero if menus can handle radio and toggle buttons. */
55 static bool
56 have_boxes (void)
58 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined(HAVE_NS)
59 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)))
60 return 1;
61 #endif
62 return 0;
65 Lisp_Object menu_items;
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. */
69 Lisp_Object menu_items_inuse;
71 /* Number of slots currently allocated in menu_items. */
72 int menu_items_allocated;
74 /* This is the index in menu_items of the first empty slot. */
75 int menu_items_used;
77 /* The number of panes currently recorded in menu_items,
78 excluding those within submenus. */
79 int menu_items_n_panes;
81 /* Current depth within submenus. */
82 static int menu_items_submenu_depth;
84 void
85 init_menu_items (void)
87 if (!NILP (menu_items_inuse))
88 error ("Trying to use a menu from within a menu-entry");
90 if (NILP (menu_items))
92 menu_items_allocated = 60;
93 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
96 menu_items_inuse = Qt;
97 menu_items_used = 0;
98 menu_items_n_panes = 0;
99 menu_items_submenu_depth = 0;
102 /* Call at the end of generating the data in menu_items. */
104 void
105 finish_menu_items (void)
109 void
110 unuse_menu_items (void)
112 menu_items_inuse = Qnil;
115 /* Call when finished using the data for the current menu
116 in menu_items. */
118 void
119 discard_menu_items (void)
121 /* Free the structure if it is especially large.
122 Otherwise, hold on to it, to save time. */
123 if (menu_items_allocated > 200)
125 menu_items = Qnil;
126 menu_items_allocated = 0;
128 eassert (NILP (menu_items_inuse));
131 /* This undoes save_menu_items, and it is called by the specpdl unwind
132 mechanism. */
134 static void
135 restore_menu_items (Lisp_Object saved)
137 menu_items = XCAR (saved);
138 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
139 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
140 saved = XCDR (saved);
141 menu_items_used = XINT (XCAR (saved));
142 saved = XCDR (saved);
143 menu_items_n_panes = XINT (XCAR (saved));
144 saved = XCDR (saved);
145 menu_items_submenu_depth = XINT (XCAR (saved));
148 /* Push the whole state of menu_items processing onto the specpdl.
149 It will be restored when the specpdl is unwound. */
151 void
152 save_menu_items (void)
154 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
155 make_number (menu_items_used),
156 make_number (menu_items_n_panes),
157 make_number (menu_items_submenu_depth));
158 record_unwind_protect (restore_menu_items, saved);
159 menu_items_inuse = Qnil;
160 menu_items = Qnil;
164 /* Ensure that there is room for ITEMS items in the menu_items vector. */
166 static void
167 ensure_menu_items (int items)
169 int incr = items - (menu_items_allocated - menu_items_used);
170 if (incr > 0)
172 menu_items = larger_vector (menu_items, incr, INT_MAX);
173 menu_items_allocated = ASIZE (menu_items);
177 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
178 || defined HAVE_NTGUI)
180 /* Begin a submenu. */
182 static void
183 push_submenu_start (void)
185 ensure_menu_items (1);
186 ASET (menu_items, menu_items_used, Qnil);
187 menu_items_used++;
188 menu_items_submenu_depth++;
191 /* End a submenu. */
193 static void
194 push_submenu_end (void)
196 ensure_menu_items (1);
197 ASET (menu_items, menu_items_used, Qlambda);
198 menu_items_used++;
199 menu_items_submenu_depth--;
202 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
204 /* Indicate boundary between left and right. */
206 static void
207 push_left_right_boundary (void)
209 ensure_menu_items (1);
210 ASET (menu_items, menu_items_used, Qquote);
211 menu_items_used++;
214 /* Start a new menu pane in menu_items.
215 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
217 static void
218 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
220 ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
221 if (menu_items_submenu_depth == 0)
222 menu_items_n_panes++;
223 ASET (menu_items, menu_items_used, Qt);
224 menu_items_used++;
225 ASET (menu_items, menu_items_used, name);
226 menu_items_used++;
227 ASET (menu_items, menu_items_used, prefix_vec);
228 menu_items_used++;
231 /* Push one menu item into the current pane. NAME is the string to
232 display. ENABLE if non-nil means this item can be selected. KEY
233 is the key generated by choosing this item, or nil if this item
234 doesn't really have a definition. DEF is the definition of this
235 item. EQUIV is the textual description of the keyboard equivalent
236 for this item (or nil if none). TYPE is the type of this menu
237 item, one of nil, `toggle' or `radio'. */
239 static void
240 push_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)
242 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
244 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
245 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
246 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
247 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
248 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
249 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
250 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
253 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
256 /* Args passed between single_keymap_panes and single_menu_item. */
257 struct skp
259 Lisp_Object pending_maps;
260 int maxdepth;
261 int notbuttons;
264 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
265 void *);
267 /* This is a recursive subroutine of keymap_panes.
268 It handles one keymap, KEYMAP.
269 The other arguments are passed along
270 or point to local variables of the previous function.
272 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
274 static void
275 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
276 Lisp_Object prefix, int maxdepth)
278 struct skp skp;
279 struct gcpro gcpro1;
281 skp.pending_maps = Qnil;
282 skp.maxdepth = maxdepth;
283 skp.notbuttons = 0;
285 if (maxdepth <= 0)
286 return;
288 push_menu_pane (pane_name, prefix);
290 if (!have_boxes ())
292 /* Remember index for first item in this pane so we can go back
293 and add a prefix when (if) we see the first button. After
294 that, notbuttons is set to 0, to mark that we have seen a
295 button and all non button items need a prefix. */
296 skp.notbuttons = menu_items_used;
299 GCPRO1 (skp.pending_maps);
300 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
301 UNGCPRO;
303 /* Process now any submenus which want to be panes at this level. */
304 while (CONSP (skp.pending_maps))
306 Lisp_Object elt, eltcdr, string;
307 elt = XCAR (skp.pending_maps);
308 eltcdr = XCDR (elt);
309 string = XCAR (eltcdr);
310 /* We no longer discard the @ from the beginning of the string here.
311 Instead, we do this in *menu_show. */
312 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
313 skp.pending_maps = XCDR (skp.pending_maps);
317 /* This is a subroutine of single_keymap_panes that handles one
318 keymap entry.
319 KEY is a key in a keymap and ITEM is its binding.
320 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
321 separate panes.
322 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
324 static void
325 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
327 Lisp_Object map, item_string, enabled;
328 struct gcpro gcpro1, gcpro2;
329 bool res;
330 struct skp *skp = skp_v;
332 /* Parse the menu item and leave the result in item_properties. */
333 GCPRO2 (key, item);
334 res = parse_menu_item (item, 0);
335 UNGCPRO;
336 if (!res)
337 return; /* Not a menu item. */
339 map = AREF (item_properties, ITEM_PROPERTY_MAP);
341 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
342 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
344 if (!NILP (map) && SREF (item_string, 0) == '@')
346 if (!NILP (enabled))
347 /* An enabled separate pane. Remember this to handle it later. */
348 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
349 skp->pending_maps);
350 return;
353 /* Simulate radio buttons and toggle boxes by putting a prefix in
354 front of them. */
355 if (!have_boxes ())
357 Lisp_Object prefix = Qnil;
358 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
359 if (!NILP (type))
361 Lisp_Object selected
362 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
364 if (skp->notbuttons)
365 /* The first button. Line up previous items in this menu. */
367 int idx = skp->notbuttons; /* Index for first item this menu. */
368 int submenu = 0;
369 Lisp_Object tem;
370 while (idx < menu_items_used)
373 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
374 if (NILP (tem))
376 idx++;
377 submenu++; /* Skip sub menu. */
379 else if (EQ (tem, Qlambda))
381 idx++;
382 submenu--; /* End sub menu. */
384 else if (EQ (tem, Qt))
385 idx += 3; /* Skip new pane marker. */
386 else if (EQ (tem, Qquote))
387 idx++; /* Skip a left, right divider. */
388 else
390 if (!submenu && SREF (tem, 0) != '\0'
391 && SREF (tem, 0) != '-')
392 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
393 concat2 (build_local_string (" "), tem));
394 idx += MENU_ITEMS_ITEM_LENGTH;
397 skp->notbuttons = 0;
400 /* Calculate prefix, if any, for this item. */
401 if (EQ (type, QCtoggle))
402 prefix = build_local_string (NILP (selected) ? "[ ] " : "[X] ");
403 else if (EQ (type, QCradio))
404 prefix = build_local_string (NILP (selected) ? "( ) " : "(*) ");
406 /* Not a button. If we have earlier buttons, then we need a prefix. */
407 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
408 && SREF (item_string, 0) != '-')
409 prefix = build_local_string (" ");
411 if (!NILP (prefix))
412 item_string = concat2 (prefix, item_string);
415 if ((FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
416 || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame)))
417 && !NILP (map))
418 /* Indicate visually that this is a submenu. */
419 item_string = concat2 (item_string, build_local_string (" >"));
421 push_menu_item (item_string, enabled, key,
422 AREF (item_properties, ITEM_PROPERTY_DEF),
423 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
424 AREF (item_properties, ITEM_PROPERTY_TYPE),
425 AREF (item_properties, ITEM_PROPERTY_SELECTED),
426 AREF (item_properties, ITEM_PROPERTY_HELP));
428 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
429 /* Display a submenu using the toolkit. */
430 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
431 && ! (NILP (map) || NILP (enabled)))
433 push_submenu_start ();
434 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
435 push_submenu_end ();
437 #endif
440 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
441 and generate menu panes for them in menu_items. */
443 static void
444 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
446 ptrdiff_t mapno;
448 init_menu_items ();
450 /* Loop over the given keymaps, making a pane for each map.
451 But don't make a pane that is empty--ignore that map instead.
452 P is the number of panes we have made so far. */
453 for (mapno = 0; mapno < nmaps; mapno++)
454 single_keymap_panes (keymaps[mapno],
455 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
457 finish_menu_items ();
460 /* Encode a menu string as appropriate for menu-updating-frame's type. */
461 static Lisp_Object
462 encode_menu_string (Lisp_Object str)
464 /* TTY menu strings are encoded by write_glyphs, when they are
465 delivered to the glass, so no need to encode them here. */
466 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)))
467 return str;
468 return ENCODE_MENU_STRING (str);
471 /* Push the items in a single pane defined by the alist PANE. */
472 static void
473 list_of_items (Lisp_Object pane)
475 Lisp_Object tail, item, item1;
477 for (tail = pane; CONSP (tail); tail = XCDR (tail))
479 item = XCAR (tail);
480 if (STRINGP (item))
481 push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt,
482 Qnil, Qnil, Qnil, Qnil);
483 else if (CONSP (item))
485 item1 = XCAR (item);
486 CHECK_STRING (item1);
487 push_menu_item (encode_menu_string (item1), Qt, XCDR (item),
488 Qt, Qnil, Qnil, Qnil, Qnil);
490 else
491 push_left_right_boundary ();
496 /* Push all the panes and items of a menu described by the
497 alist-of-alists MENU.
498 This handles old-fashioned calls to x-popup-menu. */
499 void
500 list_of_panes (Lisp_Object menu)
502 Lisp_Object tail;
504 init_menu_items ();
506 for (tail = menu; CONSP (tail); tail = XCDR (tail))
508 Lisp_Object elt, pane_name, pane_data;
509 elt = XCAR (tail);
510 pane_name = Fcar (elt);
511 CHECK_STRING (pane_name);
512 push_menu_pane (encode_menu_string (pane_name), Qnil);
513 pane_data = Fcdr (elt);
514 CHECK_CONS (pane_data);
515 list_of_items (pane_data);
518 finish_menu_items ();
521 /* Set up data in menu_items for a menu bar item
522 whose event type is ITEM_KEY (with string ITEM_NAME)
523 and whose contents come from the list of keymaps MAPS. */
524 bool
525 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
526 Lisp_Object maps)
528 Lisp_Object length;
529 EMACS_INT len;
530 Lisp_Object *mapvec;
531 ptrdiff_t i;
532 bool top_level_items = 0;
533 USE_SAFE_ALLOCA;
535 length = Flength (maps);
536 len = XINT (length);
538 /* Convert the list MAPS into a vector MAPVEC. */
539 SAFE_ALLOCA_LISP (mapvec, len);
540 for (i = 0; i < len; i++)
542 mapvec[i] = Fcar (maps);
543 maps = Fcdr (maps);
546 /* Loop over the given keymaps, making a pane for each map.
547 But don't make a pane that is empty--ignore that map instead. */
548 for (i = 0; i < len; i++)
550 if (!KEYMAPP (mapvec[i]))
552 /* Here we have a command at top level in the menu bar
553 as opposed to a submenu. */
554 top_level_items = 1;
555 push_menu_pane (Qnil, Qnil);
556 push_menu_item (item_name, Qt, item_key, mapvec[i],
557 Qnil, Qnil, Qnil, Qnil);
559 else
561 Lisp_Object prompt;
562 prompt = Fkeymap_prompt (mapvec[i]);
563 single_keymap_panes (mapvec[i],
564 !NILP (prompt) ? prompt : item_name,
565 item_key, 10);
569 SAFE_FREE ();
570 return top_level_items;
574 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
576 /* Allocate and basically initialize widget_value, blocking input. */
578 widget_value *
579 make_widget_value (const char *name, char *value,
580 bool enabled, Lisp_Object help)
582 widget_value *wv;
584 block_input ();
585 wv = xzalloc (sizeof (widget_value));
586 unblock_input ();
588 wv->name = (char *) name;
589 wv->value = value;
590 wv->enabled = enabled;
591 wv->help = help;
592 return wv;
595 /* This recursively calls xfree on the tree of widgets.
596 It must free all data that was malloc'ed for these widget_values.
597 In Emacs, many slots are pointers into the data of Lisp_Strings, and
598 must be left alone. */
600 void
601 free_menubar_widget_value_tree (widget_value *wv)
603 if (! wv) return;
605 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
607 if (wv->contents && (wv->contents != (widget_value*)1))
609 free_menubar_widget_value_tree (wv->contents);
610 wv->contents = (widget_value *) 0xDEADBEEF;
612 if (wv->next)
614 free_menubar_widget_value_tree (wv->next);
615 wv->next = (widget_value *) 0xDEADBEEF;
617 block_input ();
618 xfree (wv);
619 unblock_input ();
622 /* Create a tree of widget_value objects
623 representing the panes and items
624 in menu_items starting at index START, up to index END. */
626 widget_value *
627 digest_single_submenu (int start, int end, bool top_level_items)
629 widget_value *wv, *prev_wv, *save_wv, *first_wv;
630 int i;
631 int submenu_depth = 0;
632 widget_value **submenu_stack;
633 bool panes_seen = 0;
634 struct frame *f = XFRAME (Vmenu_updating_frame);
635 USE_SAFE_ALLOCA;
637 SAFE_NALLOCA (submenu_stack, 1, menu_items_used);
638 wv = make_widget_value ("menu", NULL, true, Qnil);
639 wv->button_type = BUTTON_TYPE_NONE;
640 first_wv = wv;
641 save_wv = 0;
642 prev_wv = 0;
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)
651 if (EQ (AREF (menu_items, i), Qnil))
653 submenu_stack[submenu_depth++] = save_wv;
654 save_wv = prev_wv;
655 prev_wv = 0;
656 i++;
658 else if (EQ (AREF (menu_items, i), Qlambda))
660 prev_wv = save_wv;
661 save_wv = submenu_stack[--submenu_depth];
662 i++;
664 else if (EQ (AREF (menu_items, i), Qt)
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. */
669 else if (EQ (AREF (menu_items, i), Qquote))
670 i += 1;
671 else if (EQ (AREF (menu_items, i), Qt))
673 /* Create a new pane. */
674 Lisp_Object pane_name;
675 const char *pane_string;
677 panes_seen = 1;
679 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
681 /* TTY menus display menu items via tty_write_glyphs, which
682 will encode the strings as appropriate. */
683 if (!FRAME_TERMCAP_P (f))
685 #ifdef HAVE_NTGUI
686 if (STRINGP (pane_name))
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);
694 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
696 #elif defined (USE_LUCID) && defined (HAVE_XFT)
697 if (STRINGP (pane_name))
699 pane_name = ENCODE_UTF_8 (pane_name);
700 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
702 #elif !defined (HAVE_MULTILINGUAL_MENU)
703 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
705 pane_name = ENCODE_MENU_STRING (pane_name);
706 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
708 #endif
711 pane_string = (NILP (pane_name)
712 ? "" : SSDATA (pane_name));
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 = "";
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, ""))
723 /* Set value to 1 so update_submenu_strings can handle '@'. */
724 wv = make_widget_value (NULL, (char *) 1, true, Qnil);
725 if (save_wv)
726 save_wv->next = wv;
727 else
728 first_wv->contents = wv;
729 wv->lname = pane_name;
730 wv->button_type = BUTTON_TYPE_NONE;
731 save_wv = wv;
733 else
734 save_wv = first_wv;
736 prev_wv = 0;
737 i += MENU_ITEMS_PANE_LENGTH;
739 else
741 /* Create a new item within current pane. */
742 Lisp_Object item_name, enable, descrip, def, type, selected;
743 Lisp_Object help;
745 /* All items should be contained in panes. */
746 if (! panes_seen)
747 emacs_abort ();
749 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
750 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
751 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
752 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
753 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
754 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
755 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
757 /* TTY menu items and their descriptions will be encoded by
758 tty_write_glyphs. */
759 if (!FRAME_TERMCAP_P (f))
761 #ifdef HAVE_NTGUI
762 if (STRINGP (item_name))
764 if (unicode_append_menu)
765 item_name = ENCODE_UTF_8 (item_name);
766 else if (STRING_MULTIBYTE (item_name))
767 item_name = ENCODE_SYSTEM (item_name);
769 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
772 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
774 descrip = ENCODE_SYSTEM (descrip);
775 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
777 #elif USE_LUCID
778 if (STRINGP (item_name))
780 item_name = ENCODE_UTF_8 (item_name);
781 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
784 if (STRINGP (descrip))
786 descrip = ENCODE_UTF_8 (descrip);
787 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
789 #elif !defined (HAVE_MULTILINGUAL_MENU)
790 if (STRING_MULTIBYTE (item_name))
792 item_name = ENCODE_MENU_STRING (item_name);
793 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
796 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
798 descrip = ENCODE_MENU_STRING (descrip);
799 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
801 #endif
804 wv = make_widget_value (NULL, NULL, !NILP (enable),
805 STRINGP (help) ? help : Qnil);
806 if (prev_wv)
807 prev_wv->next = wv;
808 else
809 save_wv->contents = wv;
811 wv->lname = item_name;
812 if (!NILP (descrip))
813 wv->lkey = descrip;
814 /* The intptr_t cast avoids a warning. There's no problem
815 as long as pointers have enough bits to hold small integers. */
816 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
818 if (NILP (type))
819 wv->button_type = BUTTON_TYPE_NONE;
820 else if (EQ (type, QCradio))
821 wv->button_type = BUTTON_TYPE_RADIO;
822 else if (EQ (type, QCtoggle))
823 wv->button_type = BUTTON_TYPE_TOGGLE;
824 else
825 emacs_abort ();
827 wv->selected = !NILP (selected);
829 prev_wv = wv;
831 i += MENU_ITEMS_ITEM_LENGTH;
835 /* If we have just one "menu item"
836 that was originally a button, return it by itself. */
837 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
839 wv = first_wv;
840 first_wv = first_wv->contents;
841 xfree (wv);
844 SAFE_FREE ();
845 return first_wv;
848 /* Walk through the widget_value tree starting at FIRST_WV and update
849 the char * pointers from the corresponding lisp values.
850 We do this after building the whole tree, since GC may happen while the
851 tree is constructed, and small strings are relocated. So we must wait
852 until no GC can happen before storing pointers into lisp values. */
853 void
854 update_submenu_strings (widget_value *first_wv)
856 widget_value *wv;
858 for (wv = first_wv; wv; wv = wv->next)
860 if (STRINGP (wv->lname))
862 wv->name = SSDATA (wv->lname);
864 /* Ignore the @ that means "separate pane".
865 This is a kludge, but this isn't worth more time. */
866 if (wv->value == (char *)1)
868 if (wv->name[0] == '@')
869 wv->name++;
870 wv->value = 0;
874 if (STRINGP (wv->lkey))
875 wv->key = SSDATA (wv->lkey);
877 if (wv->contents)
878 update_submenu_strings (wv->contents);
882 /* Find the menu selection and store it in the keyboard buffer.
883 F is the frame the menu is on.
884 MENU_BAR_ITEMS_USED is the length of VECTOR.
885 VECTOR is an array of menu events for the whole menu. */
887 void
888 find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
889 Lisp_Object vector, void *client_data)
891 Lisp_Object prefix, entry;
892 Lisp_Object *subprefix_stack;
893 int submenu_depth = 0;
894 int i;
895 USE_SAFE_ALLOCA;
897 entry = Qnil;
898 SAFE_NALLOCA (subprefix_stack, 1, menu_bar_items_used);
899 prefix = Qnil;
900 i = 0;
902 while (i < menu_bar_items_used)
904 if (EQ (AREF (vector, i), Qnil))
906 subprefix_stack[submenu_depth++] = prefix;
907 prefix = entry;
908 i++;
910 else if (EQ (AREF (vector, i), Qlambda))
912 prefix = subprefix_stack[--submenu_depth];
913 i++;
915 else if (EQ (AREF (vector, i), Qt))
917 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
918 i += MENU_ITEMS_PANE_LENGTH;
920 else
922 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
923 /* Treat the pointer as an integer. There's no problem
924 as long as pointers have enough bits to hold small integers. */
925 if ((intptr_t) client_data == i)
927 int j;
928 struct input_event buf;
929 Lisp_Object frame;
930 EVENT_INIT (buf);
932 XSETFRAME (frame, f);
933 buf.kind = MENU_BAR_EVENT;
934 buf.frame_or_window = frame;
935 buf.arg = frame;
936 kbd_buffer_store_event (&buf);
938 for (j = 0; j < submenu_depth; j++)
939 if (!NILP (subprefix_stack[j]))
941 buf.kind = MENU_BAR_EVENT;
942 buf.frame_or_window = frame;
943 buf.arg = subprefix_stack[j];
944 kbd_buffer_store_event (&buf);
947 if (!NILP (prefix))
949 buf.kind = MENU_BAR_EVENT;
950 buf.frame_or_window = frame;
951 buf.arg = prefix;
952 kbd_buffer_store_event (&buf);
955 buf.kind = MENU_BAR_EVENT;
956 buf.frame_or_window = frame;
957 buf.arg = entry;
958 kbd_buffer_store_event (&buf);
960 break;
962 i += MENU_ITEMS_ITEM_LENGTH;
966 SAFE_FREE ();
969 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
971 #ifdef HAVE_NS
972 /* As above, but return the menu selection instead of storing in kb buffer.
973 If KEYMAPS, return full prefixes to selection. */
974 Lisp_Object
975 find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
977 Lisp_Object prefix, entry;
978 int i;
979 Lisp_Object *subprefix_stack;
980 int submenu_depth = 0;
981 USE_SAFE_ALLOCA;
983 prefix = entry = Qnil;
984 i = 0;
985 SAFE_ALLOCA_LISP (subprefix_stack, menu_items_used);
987 while (i < menu_items_used)
989 if (EQ (AREF (menu_items, i), Qnil))
991 subprefix_stack[submenu_depth++] = prefix;
992 prefix = entry;
993 i++;
995 else if (EQ (AREF (menu_items, i), Qlambda))
997 prefix = subprefix_stack[--submenu_depth];
998 i++;
1000 else if (EQ (AREF (menu_items, i), Qt))
1002 prefix
1003 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1004 i += MENU_ITEMS_PANE_LENGTH;
1006 /* Ignore a nil in the item list.
1007 It's meaningful only for dialog boxes. */
1008 else if (EQ (AREF (menu_items, i), Qquote))
1009 i += 1;
1010 else
1012 entry
1013 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1014 if (aref_addr (menu_items, i) == client_data)
1016 if (keymaps)
1018 int j;
1020 entry = list1 (entry);
1021 if (!NILP (prefix))
1022 entry = Fcons (prefix, entry);
1023 for (j = submenu_depth - 1; j >= 0; j--)
1024 if (!NILP (subprefix_stack[j]))
1025 entry = Fcons (subprefix_stack[j], entry);
1027 SAFE_FREE ();
1028 return entry;
1030 i += MENU_ITEMS_ITEM_LENGTH;
1033 SAFE_FREE ();
1034 return Qnil;
1036 #endif /* HAVE_NS */
1038 ptrdiff_t
1039 menu_item_width (const unsigned char *str)
1041 ptrdiff_t len;
1042 const unsigned char *p;
1044 for (len = 0, p = str; *p; )
1046 int ch_len;
1047 int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
1049 len += CHAR_WIDTH (ch);
1050 p += ch_len;
1052 return len;
1055 DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y,
1056 2, 3, 0,
1057 doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y.
1058 X and Y are frame-relative pixel coordinates, assumed to define
1059 a location within the menu bar.
1060 If FRAME is nil or omitted, it defaults to the selected frame.
1062 Value is the symbol of the menu at X/Y, or nil if the specified
1063 coordinates are not within the FRAME's menu bar. The symbol can
1064 be used to look up the menu like this:
1066 (lookup-key MAP [menu-bar SYMBOL])
1068 where MAP is either the current global map or the current local map,
1069 since menu-bar items come from both.
1071 This function can return non-nil only on a text-terminal frame
1072 or on an X frame that doesn't use any GUI toolkit. Otherwise,
1073 Emacs does not manage the menu bar and cannot convert coordinates
1074 into menu items. */)
1075 (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
1077 int row, col;
1078 struct frame *f = decode_any_frame (frame);
1080 if (!FRAME_LIVE_P (f))
1081 return Qnil;
1083 pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1);
1084 if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
1086 Lisp_Object items, item;
1087 int i;
1089 /* Find the menu bar item under `col'. */
1090 item = Qnil;
1091 items = FRAME_MENU_BAR_ITEMS (f);
1092 /* This loop assumes a single menu-bar line, and will fail to
1093 find an item if it is not in the first line. Note that
1094 make_lispy_event in keyboard.c makes the same assumption. */
1095 for (i = 0; i < ASIZE (items); i += 4)
1097 Lisp_Object pos, str;
1099 str = AREF (items, i + 1);
1100 pos = AREF (items, i + 3);
1101 if (NILP (str))
1102 return item;
1103 if (XINT (pos) <= col
1104 /* We use <= so the blank between 2 items on a TTY is
1105 considered part of the previous item. */
1106 && col <= XINT (pos) + menu_item_width (SDATA (str)))
1108 item = AREF (items, i);
1109 return item;
1113 return Qnil;
1117 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1118 doc: /* Pop up a deck-of-cards menu and return user's selection.
1119 POSITION is a position specification. This is either a mouse button event
1120 or a list ((XOFFSET YOFFSET) WINDOW)
1121 where XOFFSET and YOFFSET are positions in pixels from the top left
1122 corner of WINDOW. (WINDOW may be a window or a frame object.)
1123 This controls the position of the top left of the menu as a whole.
1124 If POSITION is t, it means to use the current mouse position.
1126 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1127 The menu items come from key bindings that have a menu string as well as
1128 a definition; actually, the "definition" in such a key binding looks like
1129 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1130 the keymap as a top-level element.
1132 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1133 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1135 You can also use a list of keymaps as MENU.
1136 Then each keymap makes a separate pane.
1138 When MENU is a keymap or a list of keymaps, the return value is the
1139 list of events corresponding to the user's choice. Note that
1140 `x-popup-menu' does not actually execute the command bound to that
1141 sequence of events.
1143 Alternatively, you can specify a menu of multiple panes
1144 with a list of the form (TITLE PANE1 PANE2...),
1145 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1146 Each ITEM is normally a cons cell (STRING . VALUE);
1147 but a string can appear as an item--that makes a nonselectable line
1148 in the menu.
1149 With this form of menu, the return value is VALUE from the chosen item.
1151 If POSITION is nil, don't display the menu at all, just precalculate the
1152 cached information about equivalent key sequences.
1154 If the user gets rid of the menu without making a valid choice, for
1155 instance by clicking the mouse away from a valid choice or by typing
1156 keyboard input, then this normally results in a quit and
1157 `x-popup-menu' does not return. But if POSITION is a mouse button
1158 event (indicating that the user invoked the menu with the mouse) then
1159 no quit occurs and `x-popup-menu' returns nil. */)
1160 (Lisp_Object position, Lisp_Object menu)
1162 Lisp_Object keymap, tem, tem2;
1163 int xpos = 0, ypos = 0;
1164 Lisp_Object title;
1165 const char *error_name = NULL;
1166 Lisp_Object selection = Qnil;
1167 struct frame *f = NULL;
1168 Lisp_Object x, y, window;
1169 int menuflags = 0;
1170 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1171 struct gcpro gcpro1;
1173 if (NILP (position))
1174 /* This is an obsolete call, which wants us to precompute the
1175 keybinding equivalents, but we don't do that any more anyway. */
1176 return Qnil;
1179 bool get_current_pos_p = 0;
1181 /* Decode the first argument: find the window and the coordinates. */
1182 if (EQ (position, Qt)
1183 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1184 || EQ (XCAR (position), Qtool_bar))))
1186 get_current_pos_p = 1;
1188 else
1190 tem = Fcar (position);
1191 if (CONSP (tem))
1193 window = Fcar (Fcdr (position));
1194 x = XCAR (tem);
1195 y = Fcar (XCDR (tem));
1197 else
1199 menuflags |= MENU_FOR_CLICK;
1200 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1201 window = Fcar (tem); /* POSN_WINDOW (tem) */
1202 tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */
1203 /* The MENU_KBD_NAVIGATION field is set when the menu
1204 was invoked by F10, which probably means they have no
1205 mouse. In that case, we let them switch between
1206 top-level menu-bar menus by using C-f/C-b and
1207 horizontal arrow keys, since they cannot click the
1208 mouse to open a different submenu. This flag is only
1209 supported by tty_menu_show. We set it when POSITION
1210 and last_nonmenu_event are different, which means we
1211 constructed POSITION by hand (in popup-menu, see
1212 menu-bar.el) to look like a mouse click on the menu bar
1213 event. */
1214 if (!EQ (POSN_POSN (last_nonmenu_event),
1215 POSN_POSN (position))
1216 && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar))
1217 menuflags |= MENU_KBD_NAVIGATION;
1218 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1219 x = Fcar (tem);
1220 y = Fcdr (tem);
1223 /* If a click happens in an external tool bar or a detached
1224 tool bar, x and y is NIL. In that case, use the current
1225 mouse position. This happens for the help button in the
1226 tool bar. Ideally popup-menu should pass NIL to
1227 this function, but it doesn't. */
1228 if (NILP (x) && NILP (y))
1229 get_current_pos_p = 1;
1232 if (get_current_pos_p)
1234 /* Use the mouse's current position. */
1235 struct frame *new_f = SELECTED_FRAME ();
1236 #ifdef HAVE_X_WINDOWS
1237 /* Can't use mouse_position_hook for X since it returns
1238 coordinates relative to the window the mouse is in,
1239 we need coordinates relative to the edit widget always. */
1240 if (new_f != 0)
1242 int cur_x, cur_y;
1244 x_relative_mouse_position (new_f, &cur_x, &cur_y);
1245 /* cur_x/y may be negative, so use make_number. */
1246 x = make_number (cur_x);
1247 y = make_number (cur_y);
1250 #else /* not HAVE_X_WINDOWS */
1251 Lisp_Object bar_window;
1252 enum scroll_bar_part part;
1253 Time time;
1254 void (*mouse_position_hook) (struct frame **, int,
1255 Lisp_Object *,
1256 enum scroll_bar_part *,
1257 Lisp_Object *,
1258 Lisp_Object *,
1259 Time *) =
1260 FRAME_TERMINAL (new_f)->mouse_position_hook;
1262 if (mouse_position_hook)
1263 (*mouse_position_hook) (&new_f, 1, &bar_window,
1264 &part, &x, &y, &time);
1265 #endif /* not HAVE_X_WINDOWS */
1267 if (new_f != 0)
1268 XSETFRAME (window, new_f);
1269 else
1271 window = selected_window;
1272 XSETFASTINT (x, 0);
1273 XSETFASTINT (y, 0);
1277 /* Decode where to put the menu. */
1279 if (FRAMEP (window))
1281 f = XFRAME (window);
1282 xpos = 0;
1283 ypos = 0;
1285 else if (WINDOWP (window))
1287 struct window *win = XWINDOW (window);
1288 CHECK_LIVE_WINDOW (window);
1289 f = XFRAME (WINDOW_FRAME (win));
1291 xpos = WINDOW_LEFT_EDGE_X (win);
1292 ypos = WINDOW_TOP_EDGE_Y (win);
1294 else
1295 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1296 but I don't want to make one now. */
1297 CHECK_WINDOW (window);
1299 CHECK_RANGED_INTEGER (x,
1300 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1301 ? (EMACS_INT) INT_MIN - xpos
1302 : MOST_NEGATIVE_FIXNUM),
1303 INT_MAX - xpos);
1304 CHECK_RANGED_INTEGER (y,
1305 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1306 ? (EMACS_INT) INT_MIN - ypos
1307 : MOST_NEGATIVE_FIXNUM),
1308 INT_MAX - ypos);
1309 xpos += XINT (x);
1310 ypos += XINT (y);
1312 XSETFRAME (Vmenu_updating_frame, f);
1315 /* Now parse the lisp menus. */
1316 record_unwind_protect_void (unuse_menu_items);
1318 title = Qnil;
1319 GCPRO1 (title);
1321 /* Decode the menu items from what was specified. */
1323 keymap = get_keymap (menu, 0, 0);
1324 if (CONSP (keymap))
1326 /* We were given a keymap. Extract menu info from the keymap. */
1327 Lisp_Object prompt;
1329 /* Extract the detailed info to make one pane. */
1330 keymap_panes (&menu, 1);
1332 /* Search for a string appearing directly as an element of the keymap.
1333 That string is the title of the menu. */
1334 prompt = Fkeymap_prompt (keymap);
1335 if (!NILP (prompt))
1336 title = prompt;
1337 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1338 else
1339 title = build_string ("Select");
1340 #endif
1342 /* Make that be the pane title of the first pane. */
1343 if (!NILP (prompt) && menu_items_n_panes >= 0)
1344 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1346 menuflags |= MENU_KEYMAPS;
1348 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1350 /* We were given a list of keymaps. */
1351 EMACS_INT nmaps = XFASTINT (Flength (menu));
1352 Lisp_Object *maps;
1353 ptrdiff_t i;
1354 USE_SAFE_ALLOCA;
1356 SAFE_ALLOCA_LISP (maps, nmaps);
1357 title = Qnil;
1359 /* The first keymap that has a prompt string
1360 supplies the menu title. */
1361 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1363 Lisp_Object prompt;
1365 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1367 prompt = Fkeymap_prompt (keymap);
1368 if (NILP (title) && !NILP (prompt))
1369 title = prompt;
1372 /* Extract the detailed info to make one pane. */
1373 keymap_panes (maps, nmaps);
1375 /* Make the title be the pane title of the first pane. */
1376 if (!NILP (title) && menu_items_n_panes >= 0)
1377 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1379 menuflags |= MENU_KEYMAPS;
1381 SAFE_FREE ();
1383 else
1385 /* We were given an old-fashioned menu. */
1386 title = Fcar (menu);
1387 CHECK_STRING (title);
1389 list_of_panes (Fcdr (menu));
1391 menuflags &= ~MENU_KEYMAPS;
1394 unbind_to (specpdl_count, Qnil);
1396 #ifdef HAVE_WINDOW_SYSTEM
1397 /* Hide a previous tip, if any. */
1398 if (!FRAME_TERMCAP_P (f))
1399 Fx_hide_tip ();
1400 #endif
1402 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1403 /* If resources from a previous popup menu still exist, does nothing
1404 until the `menu_free_timer' has freed them (see w32fns.c). This
1405 can occur if you press ESC or click outside a menu without selecting
1406 a menu item.
1408 if (current_popup_menu && FRAME_W32_P (f))
1410 discard_menu_items ();
1411 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1412 UNGCPRO;
1413 return Qnil;
1415 #endif
1417 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1418 record_unwind_protect_void (discard_menu_items);
1419 #endif
1421 /* Display them in a menu, but not if F is the initial frame that
1422 doesn't have its hooks set (e.g., in a batch session), because
1423 such a frame cannot display menus. */
1424 if (!FRAME_INITIAL_P (f))
1425 selection = FRAME_TERMINAL (f)->menu_show_hook (f, xpos, ypos, menuflags,
1426 title, &error_name);
1428 #ifdef HAVE_NS
1429 unbind_to (specpdl_count, Qnil);
1430 #else
1431 discard_menu_items ();
1432 #endif
1434 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1435 if (FRAME_W32_P (f))
1436 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1437 #endif
1439 UNGCPRO;
1441 if (error_name) error ("%s", error_name);
1442 return selection;
1445 /* If F's terminal is not capable of displaying a popup dialog,
1446 emulate it with a menu. */
1448 static Lisp_Object
1449 emulate_dialog_with_menu (struct frame *f, Lisp_Object contents)
1451 Lisp_Object x, y, frame, newpos, prompt = Fcar (contents);
1452 int x_coord, y_coord;
1454 if (FRAME_WINDOW_P (f))
1456 x_coord = FRAME_PIXEL_WIDTH (f);
1457 y_coord = FRAME_PIXEL_HEIGHT (f);
1459 else
1461 x_coord = FRAME_COLS (f);
1462 /* Center the title at frame middle. (TTY menus have
1463 their upper-left corner at the given position.) */
1464 if (STRINGP (prompt))
1465 x_coord -= SCHARS (prompt);
1466 y_coord = FRAME_TOTAL_LINES (f);
1469 XSETFRAME (frame, f);
1470 XSETINT (x, x_coord / 2);
1471 XSETINT (y, y_coord / 2);
1472 newpos = list2 (list2 (x, y), frame);
1474 return Fx_popup_menu (newpos, list2 (prompt, contents));
1477 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
1478 doc: /* Pop up a dialog box and return user's selection.
1479 POSITION specifies which frame to use.
1480 This is normally a mouse button event or a window or frame.
1481 If POSITION is t, it means to use the frame the mouse is on.
1482 The dialog box appears in the middle of the specified frame.
1484 CONTENTS specifies the alternatives to display in the dialog box.
1485 It is a list of the form (DIALOG ITEM1 ITEM2...).
1486 Each ITEM is a cons cell (STRING . VALUE).
1487 The return value is VALUE from the chosen item.
1489 An ITEM may also be just a string--that makes a nonselectable item.
1490 An ITEM may also be nil--that means to put all preceding items
1491 on the left of the dialog box and all following items on the right.
1492 \(By default, approximately half appear on each side.)
1494 If HEADER is non-nil, the frame title for the box is "Information",
1495 otherwise it is "Question".
1497 If the user gets rid of the dialog box without making a valid choice,
1498 for instance using the window manager, then this produces a quit and
1499 `x-popup-dialog' does not return. */)
1500 (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
1502 struct frame *f = NULL;
1503 Lisp_Object window;
1505 /* Decode the first argument: find the window or frame to use. */
1506 if (EQ (position, Qt)
1507 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1508 || EQ (XCAR (position), Qtool_bar))))
1509 window = selected_window;
1510 else if (CONSP (position))
1512 Lisp_Object tem = XCAR (position);
1513 if (CONSP (tem))
1514 window = Fcar (XCDR (position));
1515 else
1517 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
1518 window = Fcar (tem); /* POSN_WINDOW (tem) */
1521 else if (WINDOWP (position) || FRAMEP (position))
1522 window = position;
1523 else
1524 window = Qnil;
1526 /* Decode where to put the menu. */
1528 if (FRAMEP (window))
1529 f = XFRAME (window);
1530 else if (WINDOWP (window))
1532 CHECK_LIVE_WINDOW (window);
1533 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1535 else
1536 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1537 but I don't want to make one now. */
1538 CHECK_WINDOW (window);
1540 /* Note that xw_popup_dialog can call menu code, so
1541 Vmenu_updating_frame should be set (Bug#17891). */
1542 eassert (f && FRAME_LIVE_P (f));
1543 XSETFRAME (Vmenu_updating_frame, f);
1545 /* Force a redisplay before showing the dialog. If a frame is created
1546 just before showing the dialog, its contents may not have been fully
1547 drawn, as this depends on timing of events from the X server. Redisplay
1548 is not done when a dialog is shown. If redisplay could be done in the
1549 X event loop (i.e. the X event loop does not run in a signal handler)
1550 this would not be needed.
1552 Do this before creating the widget value that points to Lisp
1553 string contents, because Fredisplay may GC and relocate them. */
1554 Fredisplay (Qt);
1556 /* Display the popup dialog by a terminal-specific hook ... */
1557 if (FRAME_TERMINAL (f)->popup_dialog_hook)
1559 Lisp_Object selection
1560 = FRAME_TERMINAL (f)->popup_dialog_hook (f, header, contents);
1561 #ifdef HAVE_NTGUI
1562 /* NTGUI supports only simple dialogs with Yes/No choices. For
1563 other dialogs, it returns the symbol 'unsupported--w32-dialog',
1564 as a signal for the caller to fall back to the emulation code. */
1565 if (!EQ (selection, Qunsupported__w32_dialog))
1566 #endif
1567 return selection;
1569 /* ... or emulate it with a menu. */
1570 return emulate_dialog_with_menu (f, contents);
1573 void
1574 syms_of_menu (void)
1576 staticpro (&menu_items);
1577 menu_items = Qnil;
1578 menu_items_inuse = Qnil;
1580 defsubr (&Sx_popup_menu);
1581 defsubr (&Sx_popup_dialog);
1582 defsubr (&Smenu_bar_menu_at_x_y);