Fix some errors in recently added tests
[emacs.git] / src / menu.c
blobe925f29ac5f42ee06f353471c30046a57c4558c7
1 /* Platform-independent code for terminal communications.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2015 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 char const *prefix = 0;
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) != '-')
393 AUTO_STRING (spaces, " ");
394 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
395 concat2 (spaces, tem));
397 idx += MENU_ITEMS_ITEM_LENGTH;
400 skp->notbuttons = 0;
403 /* Calculate prefix, if any, for this item. */
404 if (EQ (type, QCtoggle))
405 prefix = NILP (selected) ? "[ ] " : "[X] ";
406 else if (EQ (type, QCradio))
407 prefix = NILP (selected) ? "( ) " : "(*) ";
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 = " ";
414 if (prefix)
416 AUTO_STRING (prefix_obj, prefix);
417 item_string = concat2 (prefix_obj, item_string);
421 if ((FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
422 || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame)))
423 && !NILP (map))
424 /* Indicate visually that this is a submenu. */
426 AUTO_STRING (space_gt, " >");
427 item_string = concat2 (item_string, space_gt);
430 push_menu_item (item_string, enabled, key,
431 AREF (item_properties, ITEM_PROPERTY_DEF),
432 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
433 AREF (item_properties, ITEM_PROPERTY_TYPE),
434 AREF (item_properties, ITEM_PROPERTY_SELECTED),
435 AREF (item_properties, ITEM_PROPERTY_HELP));
437 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
438 /* Display a submenu using the toolkit. */
439 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
440 && ! (NILP (map) || NILP (enabled)))
442 push_submenu_start ();
443 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
444 push_submenu_end ();
446 #endif
449 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
450 and generate menu panes for them in menu_items. */
452 static void
453 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
455 ptrdiff_t mapno;
457 init_menu_items ();
459 /* Loop over the given keymaps, making a pane for each map.
460 But don't make a pane that is empty--ignore that map instead.
461 P is the number of panes we have made so far. */
462 for (mapno = 0; mapno < nmaps; mapno++)
463 single_keymap_panes (keymaps[mapno],
464 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
466 finish_menu_items ();
469 /* Encode a menu string as appropriate for menu-updating-frame's type. */
470 static Lisp_Object
471 encode_menu_string (Lisp_Object str)
473 /* TTY menu strings are encoded by write_glyphs, when they are
474 delivered to the glass, so no need to encode them here. */
475 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)))
476 return str;
477 return ENCODE_MENU_STRING (str);
480 /* Push the items in a single pane defined by the alist PANE. */
481 static void
482 list_of_items (Lisp_Object pane)
484 Lisp_Object tail, item, item1;
486 for (tail = pane; CONSP (tail); tail = XCDR (tail))
488 item = XCAR (tail);
489 if (STRINGP (item))
490 push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt,
491 Qnil, Qnil, Qnil, Qnil);
492 else if (CONSP (item))
494 item1 = XCAR (item);
495 CHECK_STRING (item1);
496 push_menu_item (encode_menu_string (item1), Qt, XCDR (item),
497 Qt, Qnil, Qnil, Qnil, Qnil);
499 else
500 push_left_right_boundary ();
505 /* Push all the panes and items of a menu described by the
506 alist-of-alists MENU.
507 This handles old-fashioned calls to x-popup-menu. */
508 void
509 list_of_panes (Lisp_Object menu)
511 Lisp_Object tail;
513 init_menu_items ();
515 for (tail = menu; CONSP (tail); tail = XCDR (tail))
517 Lisp_Object elt, pane_name, pane_data;
518 elt = XCAR (tail);
519 pane_name = Fcar (elt);
520 CHECK_STRING (pane_name);
521 push_menu_pane (encode_menu_string (pane_name), Qnil);
522 pane_data = Fcdr (elt);
523 CHECK_CONS (pane_data);
524 list_of_items (pane_data);
527 finish_menu_items ();
530 /* Set up data in menu_items for a menu bar item
531 whose event type is ITEM_KEY (with string ITEM_NAME)
532 and whose contents come from the list of keymaps MAPS. */
533 bool
534 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
535 Lisp_Object maps)
537 Lisp_Object length;
538 EMACS_INT len;
539 Lisp_Object *mapvec;
540 ptrdiff_t i;
541 bool top_level_items = 0;
542 USE_SAFE_ALLOCA;
544 length = Flength (maps);
545 len = XINT (length);
547 /* Convert the list MAPS into a vector MAPVEC. */
548 SAFE_ALLOCA_LISP (mapvec, len);
549 for (i = 0; i < len; i++)
551 mapvec[i] = Fcar (maps);
552 maps = Fcdr (maps);
555 /* Loop over the given keymaps, making a pane for each map.
556 But don't make a pane that is empty--ignore that map instead. */
557 for (i = 0; i < len; i++)
559 if (!KEYMAPP (mapvec[i]))
561 /* Here we have a command at top level in the menu bar
562 as opposed to a submenu. */
563 top_level_items = 1;
564 push_menu_pane (Qnil, Qnil);
565 push_menu_item (item_name, Qt, item_key, mapvec[i],
566 Qnil, Qnil, Qnil, Qnil);
568 else
570 Lisp_Object prompt;
571 prompt = Fkeymap_prompt (mapvec[i]);
572 single_keymap_panes (mapvec[i],
573 !NILP (prompt) ? prompt : item_name,
574 item_key, 10);
578 SAFE_FREE ();
579 return top_level_items;
583 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
585 /* Allocate and basically initialize widget_value, blocking input. */
587 widget_value *
588 make_widget_value (const char *name, char *value,
589 bool enabled, Lisp_Object help)
591 widget_value *wv;
593 block_input ();
594 wv = xzalloc (sizeof (widget_value));
595 unblock_input ();
597 wv->name = (char *) name;
598 wv->value = value;
599 wv->enabled = enabled;
600 wv->help = help;
601 return wv;
604 /* This recursively calls xfree on the tree of widgets.
605 It must free all data that was malloc'ed for these widget_values.
606 In Emacs, many slots are pointers into the data of Lisp_Strings, and
607 must be left alone. */
609 void
610 free_menubar_widget_value_tree (widget_value *wv)
612 if (! wv) return;
614 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
616 if (wv->contents && (wv->contents != (widget_value*)1))
618 free_menubar_widget_value_tree (wv->contents);
619 wv->contents = (widget_value *) 0xDEADBEEF;
621 if (wv->next)
623 free_menubar_widget_value_tree (wv->next);
624 wv->next = (widget_value *) 0xDEADBEEF;
626 block_input ();
627 xfree (wv);
628 unblock_input ();
631 /* Create a tree of widget_value objects
632 representing the panes and items
633 in menu_items starting at index START, up to index END. */
635 widget_value *
636 digest_single_submenu (int start, int end, bool top_level_items)
638 widget_value *wv, *prev_wv, *save_wv, *first_wv;
639 int i;
640 int submenu_depth = 0;
641 widget_value **submenu_stack;
642 bool panes_seen = 0;
643 struct frame *f = XFRAME (Vmenu_updating_frame);
644 USE_SAFE_ALLOCA;
646 SAFE_NALLOCA (submenu_stack, 1, menu_items_used);
647 wv = make_widget_value ("menu", NULL, true, Qnil);
648 wv->button_type = BUTTON_TYPE_NONE;
649 first_wv = wv;
650 save_wv = 0;
651 prev_wv = 0;
653 /* Loop over all panes and items made by the preceding call
654 to parse_single_submenu and construct a tree of widget_value objects.
655 Ignore the panes and items used by previous calls to
656 digest_single_submenu, even though those are also in menu_items. */
657 i = start;
658 while (i < end)
660 if (EQ (AREF (menu_items, i), Qnil))
662 submenu_stack[submenu_depth++] = save_wv;
663 save_wv = prev_wv;
664 prev_wv = 0;
665 i++;
667 else if (EQ (AREF (menu_items, i), Qlambda))
669 prev_wv = save_wv;
670 save_wv = submenu_stack[--submenu_depth];
671 i++;
673 else if (EQ (AREF (menu_items, i), Qt)
674 && submenu_depth != 0)
675 i += MENU_ITEMS_PANE_LENGTH;
676 /* Ignore a nil in the item list.
677 It's meaningful only for dialog boxes. */
678 else if (EQ (AREF (menu_items, i), Qquote))
679 i += 1;
680 else if (EQ (AREF (menu_items, i), Qt))
682 /* Create a new pane. */
683 Lisp_Object pane_name;
684 const char *pane_string;
686 panes_seen = 1;
688 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
690 /* TTY menus display menu items via tty_write_glyphs, which
691 will encode the strings as appropriate. */
692 if (!FRAME_TERMCAP_P (f))
694 #ifdef HAVE_NTGUI
695 if (STRINGP (pane_name))
697 if (unicode_append_menu)
698 /* Encode as UTF-8 for now. */
699 pane_name = ENCODE_UTF_8 (pane_name);
700 else if (STRING_MULTIBYTE (pane_name))
701 pane_name = ENCODE_SYSTEM (pane_name);
703 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
705 #elif defined (USE_LUCID) && defined (HAVE_XFT)
706 if (STRINGP (pane_name))
708 pane_name = ENCODE_UTF_8 (pane_name);
709 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
711 #elif !defined (HAVE_MULTILINGUAL_MENU)
712 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
714 pane_name = ENCODE_MENU_STRING (pane_name);
715 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
717 #endif
720 pane_string = (NILP (pane_name)
721 ? "" : SSDATA (pane_name));
722 /* If there is just one top-level pane, put all its items directly
723 under the top-level menu. */
724 if (menu_items_n_panes == 1)
725 pane_string = "";
727 /* If the pane has a meaningful name,
728 make the pane a top-level menu item
729 with its items as a submenu beneath it. */
730 if (strcmp (pane_string, ""))
732 /* Set value to 1 so update_submenu_strings can handle '@'. */
733 wv = make_widget_value (NULL, (char *) 1, true, Qnil);
734 if (save_wv)
735 save_wv->next = wv;
736 else
737 first_wv->contents = wv;
738 wv->lname = pane_name;
739 wv->button_type = BUTTON_TYPE_NONE;
740 save_wv = wv;
742 else
743 save_wv = first_wv;
745 prev_wv = 0;
746 i += MENU_ITEMS_PANE_LENGTH;
748 else
750 /* Create a new item within current pane. */
751 Lisp_Object item_name, enable, descrip, def, type, selected;
752 Lisp_Object help;
754 /* All items should be contained in panes. */
755 if (! panes_seen)
756 emacs_abort ();
758 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
759 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
760 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
761 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
762 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
763 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
764 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
766 /* TTY menu items and their descriptions will be encoded by
767 tty_write_glyphs. */
768 if (!FRAME_TERMCAP_P (f))
770 #ifdef HAVE_NTGUI
771 if (STRINGP (item_name))
773 if (unicode_append_menu)
774 item_name = ENCODE_UTF_8 (item_name);
775 else if (STRING_MULTIBYTE (item_name))
776 item_name = ENCODE_SYSTEM (item_name);
778 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
781 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
783 descrip = ENCODE_SYSTEM (descrip);
784 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
786 #elif USE_LUCID
787 if (STRINGP (item_name))
789 item_name = ENCODE_UTF_8 (item_name);
790 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
793 if (STRINGP (descrip))
795 descrip = ENCODE_UTF_8 (descrip);
796 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
798 #elif !defined (HAVE_MULTILINGUAL_MENU)
799 if (STRING_MULTIBYTE (item_name))
801 item_name = ENCODE_MENU_STRING (item_name);
802 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
805 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
807 descrip = ENCODE_MENU_STRING (descrip);
808 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
810 #endif
813 wv = make_widget_value (NULL, NULL, !NILP (enable),
814 STRINGP (help) ? help : Qnil);
815 if (prev_wv)
816 prev_wv->next = wv;
817 else
818 save_wv->contents = wv;
820 wv->lname = item_name;
821 if (!NILP (descrip))
822 wv->lkey = descrip;
823 /* The intptr_t cast avoids a warning. There's no problem
824 as long as pointers have enough bits to hold small integers. */
825 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
827 if (NILP (type))
828 wv->button_type = BUTTON_TYPE_NONE;
829 else if (EQ (type, QCradio))
830 wv->button_type = BUTTON_TYPE_RADIO;
831 else if (EQ (type, QCtoggle))
832 wv->button_type = BUTTON_TYPE_TOGGLE;
833 else
834 emacs_abort ();
836 wv->selected = !NILP (selected);
838 prev_wv = wv;
840 i += MENU_ITEMS_ITEM_LENGTH;
844 /* If we have just one "menu item"
845 that was originally a button, return it by itself. */
846 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
848 wv = first_wv;
849 first_wv = first_wv->contents;
850 xfree (wv);
853 SAFE_FREE ();
854 return first_wv;
857 /* Walk through the widget_value tree starting at FIRST_WV and update
858 the char * pointers from the corresponding lisp values.
859 We do this after building the whole tree, since GC may happen while the
860 tree is constructed, and small strings are relocated. So we must wait
861 until no GC can happen before storing pointers into lisp values. */
862 void
863 update_submenu_strings (widget_value *first_wv)
865 widget_value *wv;
867 for (wv = first_wv; wv; wv = wv->next)
869 if (STRINGP (wv->lname))
871 wv->name = SSDATA (wv->lname);
873 /* Ignore the @ that means "separate pane".
874 This is a kludge, but this isn't worth more time. */
875 if (wv->value == (char *)1)
877 if (wv->name[0] == '@')
878 wv->name++;
879 wv->value = 0;
883 if (STRINGP (wv->lkey))
884 wv->key = SSDATA (wv->lkey);
886 if (wv->contents)
887 update_submenu_strings (wv->contents);
891 /* Find the menu selection and store it in the keyboard buffer.
892 F is the frame the menu is on.
893 MENU_BAR_ITEMS_USED is the length of VECTOR.
894 VECTOR is an array of menu events for the whole menu. */
896 void
897 find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
898 Lisp_Object vector, void *client_data)
900 Lisp_Object prefix, entry;
901 Lisp_Object *subprefix_stack;
902 int submenu_depth = 0;
903 int i;
904 USE_SAFE_ALLOCA;
906 entry = Qnil;
907 SAFE_NALLOCA (subprefix_stack, 1, menu_bar_items_used);
908 prefix = Qnil;
909 i = 0;
911 while (i < menu_bar_items_used)
913 if (EQ (AREF (vector, i), Qnil))
915 subprefix_stack[submenu_depth++] = prefix;
916 prefix = entry;
917 i++;
919 else if (EQ (AREF (vector, i), Qlambda))
921 prefix = subprefix_stack[--submenu_depth];
922 i++;
924 else if (EQ (AREF (vector, i), Qt))
926 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
927 i += MENU_ITEMS_PANE_LENGTH;
929 else
931 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
932 /* Treat the pointer as an integer. There's no problem
933 as long as pointers have enough bits to hold small integers. */
934 if ((intptr_t) client_data == i)
936 int j;
937 struct input_event buf;
938 Lisp_Object frame;
939 EVENT_INIT (buf);
941 XSETFRAME (frame, f);
942 buf.kind = MENU_BAR_EVENT;
943 buf.frame_or_window = frame;
944 buf.arg = frame;
945 kbd_buffer_store_event (&buf);
947 for (j = 0; j < submenu_depth; j++)
948 if (!NILP (subprefix_stack[j]))
950 buf.kind = MENU_BAR_EVENT;
951 buf.frame_or_window = frame;
952 buf.arg = subprefix_stack[j];
953 kbd_buffer_store_event (&buf);
956 if (!NILP (prefix))
958 buf.kind = MENU_BAR_EVENT;
959 buf.frame_or_window = frame;
960 buf.arg = prefix;
961 kbd_buffer_store_event (&buf);
964 buf.kind = MENU_BAR_EVENT;
965 buf.frame_or_window = frame;
966 buf.arg = entry;
967 kbd_buffer_store_event (&buf);
969 break;
971 i += MENU_ITEMS_ITEM_LENGTH;
975 SAFE_FREE ();
978 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
980 #ifdef HAVE_NS
981 /* As above, but return the menu selection instead of storing in kb buffer.
982 If KEYMAPS, return full prefixes to selection. */
983 Lisp_Object
984 find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
986 Lisp_Object prefix, entry;
987 int i;
988 Lisp_Object *subprefix_stack;
989 int submenu_depth = 0;
990 USE_SAFE_ALLOCA;
992 prefix = entry = Qnil;
993 i = 0;
994 SAFE_ALLOCA_LISP (subprefix_stack, menu_items_used);
996 while (i < menu_items_used)
998 if (EQ (AREF (menu_items, i), Qnil))
1000 subprefix_stack[submenu_depth++] = prefix;
1001 prefix = entry;
1002 i++;
1004 else if (EQ (AREF (menu_items, i), Qlambda))
1006 prefix = subprefix_stack[--submenu_depth];
1007 i++;
1009 else if (EQ (AREF (menu_items, i), Qt))
1011 prefix
1012 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1013 i += MENU_ITEMS_PANE_LENGTH;
1015 /* Ignore a nil in the item list.
1016 It's meaningful only for dialog boxes. */
1017 else if (EQ (AREF (menu_items, i), Qquote))
1018 i += 1;
1019 else
1021 entry
1022 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1023 if (aref_addr (menu_items, i) == client_data)
1025 if (keymaps)
1027 int j;
1029 entry = list1 (entry);
1030 if (!NILP (prefix))
1031 entry = Fcons (prefix, entry);
1032 for (j = submenu_depth - 1; j >= 0; j--)
1033 if (!NILP (subprefix_stack[j]))
1034 entry = Fcons (subprefix_stack[j], entry);
1036 SAFE_FREE ();
1037 return entry;
1039 i += MENU_ITEMS_ITEM_LENGTH;
1042 SAFE_FREE ();
1043 return Qnil;
1045 #endif /* HAVE_NS */
1047 ptrdiff_t
1048 menu_item_width (const unsigned char *str)
1050 ptrdiff_t len;
1051 const unsigned char *p;
1053 for (len = 0, p = str; *p; )
1055 int ch_len;
1056 int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
1058 len += CHAR_WIDTH (ch);
1059 p += ch_len;
1061 return len;
1064 DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y,
1065 2, 3, 0,
1066 doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y.
1067 X and Y are frame-relative pixel coordinates, assumed to define
1068 a location within the menu bar.
1069 If FRAME is nil or omitted, it defaults to the selected frame.
1071 Value is the symbol of the menu at X/Y, or nil if the specified
1072 coordinates are not within the FRAME's menu bar. The symbol can
1073 be used to look up the menu like this:
1075 (lookup-key MAP [menu-bar SYMBOL])
1077 where MAP is either the current global map or the current local map,
1078 since menu-bar items come from both.
1080 This function can return non-nil only on a text-terminal frame
1081 or on an X frame that doesn't use any GUI toolkit. Otherwise,
1082 Emacs does not manage the menu bar and cannot convert coordinates
1083 into menu items. */)
1084 (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
1086 int row, col;
1087 struct frame *f = decode_any_frame (frame);
1089 if (!FRAME_LIVE_P (f))
1090 return Qnil;
1092 pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1);
1093 if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
1095 Lisp_Object items, item;
1096 int i;
1098 /* Find the menu bar item under `col'. */
1099 item = Qnil;
1100 items = FRAME_MENU_BAR_ITEMS (f);
1101 /* This loop assumes a single menu-bar line, and will fail to
1102 find an item if it is not in the first line. Note that
1103 make_lispy_event in keyboard.c makes the same assumption. */
1104 for (i = 0; i < ASIZE (items); i += 4)
1106 Lisp_Object pos, str;
1108 str = AREF (items, i + 1);
1109 pos = AREF (items, i + 3);
1110 if (NILP (str))
1111 return item;
1112 if (XINT (pos) <= col
1113 /* We use <= so the blank between 2 items on a TTY is
1114 considered part of the previous item. */
1115 && col <= XINT (pos) + menu_item_width (SDATA (str)))
1117 item = AREF (items, i);
1118 return item;
1122 return Qnil;
1126 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1127 doc: /* Pop up a deck-of-cards menu and return user's selection.
1128 POSITION is a position specification. This is either a mouse button event
1129 or a list ((XOFFSET YOFFSET) WINDOW)
1130 where XOFFSET and YOFFSET are positions in pixels from the top left
1131 corner of WINDOW. (WINDOW may be a window or a frame object.)
1132 This controls the position of the top left of the menu as a whole.
1133 If POSITION is t, it means to use the current mouse position.
1135 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1136 The menu items come from key bindings that have a menu string as well as
1137 a definition; actually, the "definition" in such a key binding looks like
1138 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1139 the keymap as a top-level element.
1141 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1142 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1144 You can also use a list of keymaps as MENU.
1145 Then each keymap makes a separate pane.
1147 When MENU is a keymap or a list of keymaps, the return value is the
1148 list of events corresponding to the user's choice. Note that
1149 `x-popup-menu' does not actually execute the command bound to that
1150 sequence of events.
1152 Alternatively, you can specify a menu of multiple panes
1153 with a list of the form (TITLE PANE1 PANE2...),
1154 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1155 Each ITEM is normally a cons cell (STRING . VALUE);
1156 but a string can appear as an item--that makes a nonselectable line
1157 in the menu.
1158 With this form of menu, the return value is VALUE from the chosen item.
1160 If POSITION is nil, don't display the menu at all, just precalculate the
1161 cached information about equivalent key sequences.
1163 If the user gets rid of the menu without making a valid choice, for
1164 instance by clicking the mouse away from a valid choice or by typing
1165 keyboard input, then this normally results in a quit and
1166 `x-popup-menu' does not return. But if POSITION is a mouse button
1167 event (indicating that the user invoked the menu with the mouse) then
1168 no quit occurs and `x-popup-menu' returns nil. */)
1169 (Lisp_Object position, Lisp_Object menu)
1171 Lisp_Object keymap, tem, tem2;
1172 int xpos = 0, ypos = 0;
1173 Lisp_Object title;
1174 const char *error_name = NULL;
1175 Lisp_Object selection = Qnil;
1176 struct frame *f = NULL;
1177 Lisp_Object x, y, window;
1178 int menuflags = 0;
1179 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1180 struct gcpro gcpro1;
1182 if (NILP (position))
1183 /* This is an obsolete call, which wants us to precompute the
1184 keybinding equivalents, but we don't do that any more anyway. */
1185 return Qnil;
1188 bool get_current_pos_p = 0;
1190 /* Decode the first argument: find the window and the coordinates. */
1191 if (EQ (position, Qt)
1192 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1193 || EQ (XCAR (position), Qtool_bar))))
1195 get_current_pos_p = 1;
1197 else
1199 tem = Fcar (position);
1200 if (CONSP (tem))
1202 window = Fcar (Fcdr (position));
1203 x = XCAR (tem);
1204 y = Fcar (XCDR (tem));
1206 else
1208 menuflags |= MENU_FOR_CLICK;
1209 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1210 window = Fcar (tem); /* POSN_WINDOW (tem) */
1211 tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */
1212 /* The MENU_KBD_NAVIGATION field is set when the menu
1213 was invoked by F10, which probably means they have no
1214 mouse. In that case, we let them switch between
1215 top-level menu-bar menus by using C-f/C-b and
1216 horizontal arrow keys, since they cannot click the
1217 mouse to open a different submenu. This flag is only
1218 supported by tty_menu_show. We set it when POSITION
1219 and last_nonmenu_event are different, which means we
1220 constructed POSITION by hand (in popup-menu, see
1221 menu-bar.el) to look like a mouse click on the menu bar
1222 event. */
1223 if (!EQ (POSN_POSN (last_nonmenu_event),
1224 POSN_POSN (position))
1225 && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar))
1226 menuflags |= MENU_KBD_NAVIGATION;
1227 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1228 x = Fcar (tem);
1229 y = Fcdr (tem);
1232 /* If a click happens in an external tool bar or a detached
1233 tool bar, x and y is NIL. In that case, use the current
1234 mouse position. This happens for the help button in the
1235 tool bar. Ideally popup-menu should pass NIL to
1236 this function, but it doesn't. */
1237 if (NILP (x) && NILP (y))
1238 get_current_pos_p = 1;
1241 if (get_current_pos_p)
1243 /* Use the mouse's current position. */
1244 struct frame *new_f = SELECTED_FRAME ();
1245 #ifdef HAVE_X_WINDOWS
1246 if (FRAME_X_P (new_f))
1248 /* Can't use mouse_position_hook for X since it returns
1249 coordinates relative to the window the mouse is in,
1250 we need coordinates relative to the edit widget always. */
1251 if (new_f != 0)
1253 int cur_x, cur_y;
1255 x_relative_mouse_position (new_f, &cur_x, &cur_y);
1256 /* cur_x/y may be negative, so use make_number. */
1257 x = make_number (cur_x);
1258 y = make_number (cur_y);
1261 else
1262 #endif /* HAVE_X_WINDOWS */
1264 Lisp_Object bar_window;
1265 enum scroll_bar_part part;
1266 Time time;
1267 void (*mouse_position_hook) (struct frame **, int,
1268 Lisp_Object *,
1269 enum scroll_bar_part *,
1270 Lisp_Object *,
1271 Lisp_Object *,
1272 Time *) =
1273 FRAME_TERMINAL (new_f)->mouse_position_hook;
1275 if (mouse_position_hook)
1276 (*mouse_position_hook) (&new_f, 1, &bar_window,
1277 &part, &x, &y, &time);
1280 if (new_f != 0)
1281 XSETFRAME (window, new_f);
1282 else
1284 window = selected_window;
1285 XSETFASTINT (x, 0);
1286 XSETFASTINT (y, 0);
1290 /* Decode where to put the menu. */
1292 if (FRAMEP (window))
1294 f = XFRAME (window);
1295 xpos = 0;
1296 ypos = 0;
1298 else if (WINDOWP (window))
1300 struct window *win = XWINDOW (window);
1301 CHECK_LIVE_WINDOW (window);
1302 f = XFRAME (WINDOW_FRAME (win));
1304 xpos = WINDOW_LEFT_EDGE_X (win);
1305 ypos = WINDOW_TOP_EDGE_Y (win);
1307 else
1308 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1309 but I don't want to make one now. */
1310 CHECK_WINDOW (window);
1312 CHECK_RANGED_INTEGER (x,
1313 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1314 ? (EMACS_INT) INT_MIN - xpos
1315 : MOST_NEGATIVE_FIXNUM),
1316 INT_MAX - xpos);
1317 CHECK_RANGED_INTEGER (y,
1318 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1319 ? (EMACS_INT) INT_MIN - ypos
1320 : MOST_NEGATIVE_FIXNUM),
1321 INT_MAX - ypos);
1322 xpos += XINT (x);
1323 ypos += XINT (y);
1325 XSETFRAME (Vmenu_updating_frame, f);
1328 /* Now parse the lisp menus. */
1329 record_unwind_protect_void (unuse_menu_items);
1331 title = Qnil;
1332 GCPRO1 (title);
1334 /* Decode the menu items from what was specified. */
1336 keymap = get_keymap (menu, 0, 0);
1337 if (CONSP (keymap))
1339 /* We were given a keymap. Extract menu info from the keymap. */
1340 Lisp_Object prompt;
1342 /* Extract the detailed info to make one pane. */
1343 keymap_panes (&menu, 1);
1345 /* Search for a string appearing directly as an element of the keymap.
1346 That string is the title of the menu. */
1347 prompt = Fkeymap_prompt (keymap);
1348 if (!NILP (prompt))
1349 title = prompt;
1350 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1351 else
1352 title = build_string ("Select");
1353 #endif
1355 /* Make that be the pane title of the first pane. */
1356 if (!NILP (prompt) && menu_items_n_panes >= 0)
1357 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1359 menuflags |= MENU_KEYMAPS;
1361 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1363 /* We were given a list of keymaps. */
1364 EMACS_INT nmaps = XFASTINT (Flength (menu));
1365 Lisp_Object *maps;
1366 ptrdiff_t i;
1367 USE_SAFE_ALLOCA;
1369 SAFE_ALLOCA_LISP (maps, nmaps);
1370 title = Qnil;
1372 /* The first keymap that has a prompt string
1373 supplies the menu title. */
1374 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1376 Lisp_Object prompt;
1378 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1380 prompt = Fkeymap_prompt (keymap);
1381 if (NILP (title) && !NILP (prompt))
1382 title = prompt;
1385 /* Extract the detailed info to make one pane. */
1386 keymap_panes (maps, nmaps);
1388 /* Make the title be the pane title of the first pane. */
1389 if (!NILP (title) && menu_items_n_panes >= 0)
1390 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1392 menuflags |= MENU_KEYMAPS;
1394 SAFE_FREE ();
1396 else
1398 /* We were given an old-fashioned menu. */
1399 title = Fcar (menu);
1400 CHECK_STRING (title);
1402 list_of_panes (Fcdr (menu));
1404 menuflags &= ~MENU_KEYMAPS;
1407 unbind_to (specpdl_count, Qnil);
1409 #ifdef HAVE_WINDOW_SYSTEM
1410 /* Hide a previous tip, if any. */
1411 if (!FRAME_TERMCAP_P (f))
1412 Fx_hide_tip ();
1413 #endif
1415 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1416 /* If resources from a previous popup menu still exist, does nothing
1417 until the `menu_free_timer' has freed them (see w32fns.c). This
1418 can occur if you press ESC or click outside a menu without selecting
1419 a menu item.
1421 if (current_popup_menu && FRAME_W32_P (f))
1423 discard_menu_items ();
1424 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1425 UNGCPRO;
1426 return Qnil;
1428 #endif
1430 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1431 record_unwind_protect_void (discard_menu_items);
1432 #endif
1434 /* Display them in a menu, but not if F is the initial frame that
1435 doesn't have its hooks set (e.g., in a batch session), because
1436 such a frame cannot display menus. */
1437 if (!FRAME_INITIAL_P (f))
1438 selection = FRAME_TERMINAL (f)->menu_show_hook (f, xpos, ypos, menuflags,
1439 title, &error_name);
1441 #ifdef HAVE_NS
1442 unbind_to (specpdl_count, Qnil);
1443 #else
1444 discard_menu_items ();
1445 #endif
1447 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1448 if (FRAME_W32_P (f))
1449 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1450 #endif
1452 UNGCPRO;
1454 if (error_name) error ("%s", error_name);
1455 return selection;
1458 /* If F's terminal is not capable of displaying a popup dialog,
1459 emulate it with a menu. */
1461 static Lisp_Object
1462 emulate_dialog_with_menu (struct frame *f, Lisp_Object contents)
1464 Lisp_Object x, y, frame, newpos, prompt = Fcar (contents);
1465 int x_coord, y_coord;
1467 if (FRAME_WINDOW_P (f))
1469 x_coord = FRAME_PIXEL_WIDTH (f);
1470 y_coord = FRAME_PIXEL_HEIGHT (f);
1472 else
1474 x_coord = FRAME_COLS (f);
1475 /* Center the title at frame middle. (TTY menus have
1476 their upper-left corner at the given position.) */
1477 if (STRINGP (prompt))
1478 x_coord -= SCHARS (prompt);
1479 y_coord = FRAME_TOTAL_LINES (f);
1482 XSETFRAME (frame, f);
1483 XSETINT (x, x_coord / 2);
1484 XSETINT (y, y_coord / 2);
1485 newpos = list2 (list2 (x, y), frame);
1487 return Fx_popup_menu (newpos, list2 (prompt, contents));
1490 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
1491 doc: /* Pop up a dialog box and return user's selection.
1492 POSITION specifies which frame to use.
1493 This is normally a mouse button event or a window or frame.
1494 If POSITION is t, it means to use the frame the mouse is on.
1495 The dialog box appears in the middle of the specified frame.
1497 CONTENTS specifies the alternatives to display in the dialog box.
1498 It is a list of the form (DIALOG ITEM1 ITEM2...).
1499 Each ITEM is a cons cell (STRING . VALUE).
1500 The return value is VALUE from the chosen item.
1502 An ITEM may also be just a string--that makes a nonselectable item.
1503 An ITEM may also be nil--that means to put all preceding items
1504 on the left of the dialog box and all following items on the right.
1505 \(By default, approximately half appear on each side.)
1507 If HEADER is non-nil, the frame title for the box is "Information",
1508 otherwise it is "Question".
1510 If the user gets rid of the dialog box without making a valid choice,
1511 for instance using the window manager, then this produces a quit and
1512 `x-popup-dialog' does not return. */)
1513 (Lisp_Object position, Lisp_Object contents, Lisp_Object header)
1515 struct frame *f = NULL;
1516 Lisp_Object window;
1518 /* Decode the first argument: find the window or frame to use. */
1519 if (EQ (position, Qt)
1520 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1521 || EQ (XCAR (position), Qtool_bar))))
1522 window = selected_window;
1523 else if (CONSP (position))
1525 Lisp_Object tem = XCAR (position);
1526 if (CONSP (tem))
1527 window = Fcar (XCDR (position));
1528 else
1530 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
1531 window = Fcar (tem); /* POSN_WINDOW (tem) */
1534 else if (WINDOWP (position) || FRAMEP (position))
1535 window = position;
1536 else
1537 window = Qnil;
1539 /* Decode where to put the menu. */
1541 if (FRAMEP (window))
1542 f = XFRAME (window);
1543 else if (WINDOWP (window))
1545 CHECK_LIVE_WINDOW (window);
1546 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1548 else
1549 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1550 but I don't want to make one now. */
1551 CHECK_WINDOW (window);
1553 /* Note that xw_popup_dialog can call menu code, so
1554 Vmenu_updating_frame should be set (Bug#17891). */
1555 eassert (f && FRAME_LIVE_P (f));
1556 XSETFRAME (Vmenu_updating_frame, f);
1558 /* Force a redisplay before showing the dialog. If a frame is created
1559 just before showing the dialog, its contents may not have been fully
1560 drawn, as this depends on timing of events from the X server. Redisplay
1561 is not done when a dialog is shown. If redisplay could be done in the
1562 X event loop (i.e. the X event loop does not run in a signal handler)
1563 this would not be needed.
1565 Do this before creating the widget value that points to Lisp
1566 string contents, because Fredisplay may GC and relocate them. */
1567 Fredisplay (Qt);
1569 /* Display the popup dialog by a terminal-specific hook ... */
1570 if (FRAME_TERMINAL (f)->popup_dialog_hook)
1572 Lisp_Object selection
1573 = FRAME_TERMINAL (f)->popup_dialog_hook (f, header, contents);
1574 #ifdef HAVE_NTGUI
1575 /* NTGUI supports only simple dialogs with Yes/No choices. For
1576 other dialogs, it returns the symbol 'unsupported--w32-dialog',
1577 as a signal for the caller to fall back to the emulation code. */
1578 if (!EQ (selection, Qunsupported__w32_dialog))
1579 #endif
1580 return selection;
1582 /* ... or emulate it with a menu. */
1583 return emulate_dialog_with_menu (f, contents);
1586 void
1587 syms_of_menu (void)
1589 staticpro (&menu_items);
1590 menu_items = Qnil;
1591 menu_items_inuse = Qnil;
1593 defsubr (&Sx_popup_menu);
1594 defsubr (&Sx_popup_dialog);
1595 defsubr (&Smenu_bar_menu_at_x_y);