* syntax.c (Fskip_syntax_backward): Doc clarification.
[emacs.git] / src / menu.c
blob9c08ff176652beab14f519f59ecbf0633cdb5381
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 #if ! (defined USE_GTK || defined USE_MOTIF)
70 static
71 #endif
72 Lisp_Object menu_items_inuse;
74 /* Number of slots currently allocated in menu_items. */
75 int menu_items_allocated;
77 /* This is the index in menu_items of the first empty slot. */
78 int menu_items_used;
80 /* The number of panes currently recorded in menu_items,
81 excluding those within submenus. */
82 int menu_items_n_panes;
84 /* Current depth within submenus. */
85 static int menu_items_submenu_depth;
87 void
88 init_menu_items (void)
90 if (!NILP (menu_items_inuse))
91 error ("Trying to use a menu from within a menu-entry");
93 if (NILP (menu_items))
95 menu_items_allocated = 60;
96 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
99 menu_items_inuse = Qt;
100 menu_items_used = 0;
101 menu_items_n_panes = 0;
102 menu_items_submenu_depth = 0;
105 /* Call at the end of generating the data in menu_items. */
107 void
108 finish_menu_items (void)
112 void
113 unuse_menu_items (void)
115 menu_items_inuse = Qnil;
118 /* Call when finished using the data for the current menu
119 in menu_items. */
121 void
122 discard_menu_items (void)
124 /* Free the structure if it is especially large.
125 Otherwise, hold on to it, to save time. */
126 if (menu_items_allocated > 200)
128 menu_items = Qnil;
129 menu_items_allocated = 0;
131 eassert (NILP (menu_items_inuse));
134 /* This undoes save_menu_items, and it is called by the specpdl unwind
135 mechanism. */
137 static void
138 restore_menu_items (Lisp_Object saved)
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));
151 /* Push the whole state of menu_items processing onto the specpdl.
152 It will be restored when the specpdl is unwound. */
154 void
155 save_menu_items (void)
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;
167 /* Ensure that there is room for ITEMS items in the menu_items vector. */
169 static void
170 ensure_menu_items (int items)
172 int incr = items - (menu_items_allocated - menu_items_used);
173 if (incr > 0)
175 menu_items = larger_vector (menu_items, incr, INT_MAX);
176 menu_items_allocated = ASIZE (menu_items);
180 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
181 || defined HAVE_NTGUI)
183 /* Begin a submenu. */
185 static void
186 push_submenu_start (void)
188 ensure_menu_items (1);
189 ASET (menu_items, menu_items_used, Qnil);
190 menu_items_used++;
191 menu_items_submenu_depth++;
194 /* End a submenu. */
196 static void
197 push_submenu_end (void)
199 ensure_menu_items (1);
200 ASET (menu_items, menu_items_used, Qlambda);
201 menu_items_used++;
202 menu_items_submenu_depth--;
205 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
207 /* Indicate boundary between left and right. */
209 static void
210 push_left_right_boundary (void)
212 ensure_menu_items (1);
213 ASET (menu_items, menu_items_used, Qquote);
214 menu_items_used++;
217 /* Start a new menu pane in menu_items.
218 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
220 static void
221 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
223 ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
224 if (menu_items_submenu_depth == 0)
225 menu_items_n_panes++;
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++;
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'. */
242 static void
243 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)
245 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
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);
256 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
259 /* Args passed between single_keymap_panes and single_menu_item. */
260 struct skp
262 Lisp_Object pending_maps;
263 int maxdepth;
264 int notbuttons;
267 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
268 void *);
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.
275 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
277 static void
278 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
279 Lisp_Object prefix, int maxdepth)
281 struct skp skp;
282 struct gcpro gcpro1;
284 skp.pending_maps = Qnil;
285 skp.maxdepth = maxdepth;
286 skp.notbuttons = 0;
288 if (maxdepth <= 0)
289 return;
291 push_menu_pane (pane_name, prefix);
293 if (!have_boxes ())
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;
302 GCPRO1 (skp.pending_maps);
303 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
304 UNGCPRO;
306 /* Process now any submenus which want to be panes at this level. */
307 while (CONSP (skp.pending_maps))
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. */
315 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
316 skp.pending_maps = XCDR (skp.pending_maps);
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.
325 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
327 static void
328 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
330 Lisp_Object map, item_string, enabled;
331 struct gcpro gcpro1, gcpro2;
332 bool res;
333 struct skp *skp = skp_v;
335 /* Parse the menu item and leave the result in item_properties. */
336 GCPRO2 (key, item);
337 res = parse_menu_item (item, 0);
338 UNGCPRO;
339 if (!res)
340 return; /* Not a menu item. */
342 map = AREF (item_properties, ITEM_PROPERTY_MAP);
344 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
345 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
347 if (!NILP (map) && SREF (item_string, 0) == '@')
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;
356 /* Simulate radio buttons and toggle boxes by putting a prefix in
357 front of them. */
358 if (!have_boxes ())
360 Lisp_Object prefix = Qnil;
361 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
362 if (!NILP (type))
364 Lisp_Object selected
365 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
367 if (skp->notbuttons)
368 /* The first button. Line up previous items in this menu. */
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)
376 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
377 if (NILP (tem))
379 idx++;
380 submenu++; /* Skip sub menu. */
382 else if (EQ (tem, Qlambda))
384 idx++;
385 submenu--; /* End sub menu. */
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
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;
400 skp->notbuttons = 0;
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) ? "( ) " : "(*) ");
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 (" ");
414 if (!NILP (prefix))
415 item_string = concat2 (prefix, item_string);
418 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
419 && !NILP (map))
420 /* Indicate visually that this is a submenu. */
421 item_string = concat2 (item_string, build_string (" >"));
423 push_menu_item (item_string, enabled, key,
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));
430 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
431 /* Display a submenu using the toolkit. */
432 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
433 && ! (NILP (map) || NILP (enabled)))
435 push_submenu_start ();
436 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
437 push_submenu_end ();
439 #endif
442 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
443 and generate menu panes for them in menu_items. */
445 static void
446 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
448 ptrdiff_t mapno;
450 init_menu_items ();
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],
457 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
459 finish_menu_items ();
462 /* Encode a menu string as appropriate for menu-updating-frame's type. */
463 static Lisp_Object
464 encode_menu_string (Lisp_Object str)
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);
473 /* Push the items in a single pane defined by the alist PANE. */
474 static void
475 list_of_items (Lisp_Object pane)
477 Lisp_Object tail, item, item1;
479 for (tail = pane; CONSP (tail); tail = XCDR (tail))
481 item = XCAR (tail);
482 if (STRINGP (item))
483 push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt,
484 Qnil, Qnil, Qnil, Qnil);
485 else if (CONSP (item))
487 item1 = XCAR (item);
488 CHECK_STRING (item1);
489 push_menu_item (encode_menu_string (item1), Qt, XCDR (item),
490 Qt, Qnil, Qnil, Qnil, Qnil);
492 else
493 push_left_right_boundary ();
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. */
501 void
502 list_of_panes (Lisp_Object menu)
504 Lisp_Object tail;
506 init_menu_items ();
508 for (tail = menu; CONSP (tail); tail = XCDR (tail))
510 Lisp_Object elt, pane_name, pane_data;
511 elt = XCAR (tail);
512 pane_name = Fcar (elt);
513 CHECK_STRING (pane_name);
514 push_menu_pane (encode_menu_string (pane_name), Qnil);
515 pane_data = Fcdr (elt);
516 CHECK_CONS (pane_data);
517 list_of_items (pane_data);
520 finish_menu_items ();
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. */
526 bool
527 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
528 Lisp_Object maps)
530 Lisp_Object length;
531 EMACS_INT len;
532 Lisp_Object *mapvec;
533 ptrdiff_t i;
534 bool top_level_items = 0;
535 USE_SAFE_ALLOCA;
537 length = Flength (maps);
538 len = XINT (length);
540 /* Convert the list MAPS into a vector MAPVEC. */
541 SAFE_ALLOCA_LISP (mapvec, len);
542 for (i = 0; i < len; i++)
544 mapvec[i] = Fcar (maps);
545 maps = Fcdr (maps);
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++)
552 if (!KEYMAPP (mapvec[i]))
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);
561 else
563 Lisp_Object prompt;
564 prompt = Fkeymap_prompt (mapvec[i]);
565 single_keymap_panes (mapvec[i],
566 !NILP (prompt) ? prompt : item_name,
567 item_key, 10);
571 SAFE_FREE ();
572 return top_level_items;
576 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
578 /* Allocate a widget_value, blocking input. */
580 widget_value *
581 xmalloc_widget_value (void)
583 widget_value *value;
585 block_input ();
586 value = malloc_widget_value ();
587 unblock_input ();
589 return value;
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. */
597 void
598 free_menubar_widget_value_tree (widget_value *wv)
600 if (! wv) return;
602 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
604 if (wv->contents && (wv->contents != (widget_value*)1))
606 free_menubar_widget_value_tree (wv->contents);
607 wv->contents = (widget_value *) 0xDEADBEEF;
609 if (wv->next)
611 free_menubar_widget_value_tree (wv->next);
612 wv->next = (widget_value *) 0xDEADBEEF;
614 block_input ();
615 free_widget_value (wv);
616 unblock_input ();
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. */
623 widget_value *
624 digest_single_submenu (int start, int end, bool top_level_items)
626 widget_value *wv, *prev_wv, *save_wv, *first_wv;
627 int i;
628 int submenu_depth = 0;
629 widget_value **submenu_stack;
630 bool panes_seen = 0;
631 struct frame *f = XFRAME (Vmenu_updating_frame);
633 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
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;
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 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;
736 else
737 save_wv = first_wv;
739 prev_wv = 0;
740 i += MENU_ITEMS_PANE_LENGTH;
742 else
744 /* Create a new item within current pane. */
745 Lisp_Object item_name, enable, descrip, def, type, selected;
746 Lisp_Object help;
748 /* All items should be contained in panes. */
749 if (! panes_seen)
750 emacs_abort ();
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);
760 /* TTY menu items and their descriptions will be encoded by
761 tty_write_glyphs. */
762 if (!FRAME_TERMCAP_P (f))
764 #ifdef HAVE_NTGUI
765 if (STRINGP (item_name))
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);
772 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
775 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
777 descrip = ENCODE_SYSTEM (descrip);
778 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
780 #elif USE_LUCID
781 if (STRINGP (item_name))
783 item_name = ENCODE_UTF_8 (item_name);
784 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
787 if (STRINGP (descrip))
789 descrip = ENCODE_UTF_8 (descrip);
790 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
792 #elif !defined (HAVE_MULTILINGUAL_MENU)
793 if (STRING_MULTIBYTE (item_name))
795 item_name = ENCODE_MENU_STRING (item_name);
796 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
799 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
801 descrip = ENCODE_MENU_STRING (descrip);
802 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
804 #endif
807 wv = xmalloc_widget_value ();
808 if (prev_wv)
809 prev_wv->next = wv;
810 else
811 save_wv->contents = wv;
813 wv->lname = item_name;
814 if (!NILP (descrip))
815 wv->lkey = descrip;
816 wv->value = 0;
817 /* The intptr_t cast avoids a warning. There's no problem
818 as long as pointers have enough bits to hold small integers. */
819 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
820 wv->enabled = !NILP (enable);
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
829 emacs_abort ();
831 wv->selected = !NILP (selected);
832 if (! STRINGP (help))
833 help = Qnil;
835 wv->help = help;
837 prev_wv = wv;
839 i += MENU_ITEMS_ITEM_LENGTH;
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)
847 wv = first_wv->contents;
848 free_widget_value (first_wv);
849 return wv;
852 return first_wv;
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. */
860 void
861 update_submenu_strings (widget_value *first_wv)
863 widget_value *wv;
865 for (wv = first_wv; wv; wv = wv->next)
867 if (STRINGP (wv->lname))
869 wv->name = SSDATA (wv->lname);
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)
875 if (wv->name[0] == '@')
876 wv->name++;
877 wv->value = 0;
881 if (STRINGP (wv->lkey))
882 wv->key = SSDATA (wv->lkey);
884 if (wv->contents)
885 update_submenu_strings (wv->contents);
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. */
894 void
895 find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
896 Lisp_Object vector, void *client_data)
898 Lisp_Object prefix, entry;
899 Lisp_Object *subprefix_stack;
900 int submenu_depth = 0;
901 int i;
903 entry = Qnil;
904 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
905 prefix = Qnil;
906 i = 0;
908 while (i < menu_bar_items_used)
910 if (EQ (AREF (vector, i), Qnil))
912 subprefix_stack[submenu_depth++] = prefix;
913 prefix = entry;
914 i++;
916 else if (EQ (AREF (vector, i), Qlambda))
918 prefix = subprefix_stack[--submenu_depth];
919 i++;
921 else if (EQ (AREF (vector, i), Qt))
923 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
924 i += MENU_ITEMS_PANE_LENGTH;
926 else
928 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
929 /* Treat the pointer as an integer. There's no problem
930 as long as pointers have enough bits to hold small integers. */
931 if ((intptr_t) client_data == i)
933 int j;
934 struct input_event buf;
935 Lisp_Object frame;
936 EVENT_INIT (buf);
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);
944 for (j = 0; j < submenu_depth; j++)
945 if (!NILP (subprefix_stack[j]))
947 buf.kind = MENU_BAR_EVENT;
948 buf.frame_or_window = frame;
949 buf.arg = subprefix_stack[j];
950 kbd_buffer_store_event (&buf);
953 if (!NILP (prefix))
955 buf.kind = MENU_BAR_EVENT;
956 buf.frame_or_window = frame;
957 buf.arg = prefix;
958 kbd_buffer_store_event (&buf);
961 buf.kind = MENU_BAR_EVENT;
962 buf.frame_or_window = frame;
963 buf.arg = entry;
964 kbd_buffer_store_event (&buf);
966 return;
968 i += MENU_ITEMS_ITEM_LENGTH;
973 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
975 #ifdef HAVE_NS
976 /* As above, but return the menu selection instead of storing in kb buffer.
977 If KEYMAPS, return full prefixes to selection. */
978 Lisp_Object
979 find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
981 Lisp_Object prefix, entry;
982 int i;
983 Lisp_Object *subprefix_stack;
984 int submenu_depth = 0;
986 prefix = entry = Qnil;
987 i = 0;
988 subprefix_stack = alloca (menu_items_used * word_size);
990 while (i < menu_items_used)
992 if (EQ (AREF (menu_items, i), Qnil))
994 subprefix_stack[submenu_depth++] = prefix;
995 prefix = entry;
996 i++;
998 else if (EQ (AREF (menu_items, i), Qlambda))
1000 prefix = subprefix_stack[--submenu_depth];
1001 i++;
1003 else if (EQ (AREF (menu_items, i), Qt))
1005 prefix
1006 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1007 i += MENU_ITEMS_PANE_LENGTH;
1009 /* Ignore a nil in the item list.
1010 It's meaningful only for dialog boxes. */
1011 else if (EQ (AREF (menu_items, i), Qquote))
1012 i += 1;
1013 else
1015 entry
1016 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1017 if (aref_addr (menu_items, i) == client_data)
1019 if (keymaps)
1021 int j;
1023 entry = list1 (entry);
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);
1030 return entry;
1032 i += MENU_ITEMS_ITEM_LENGTH;
1035 return Qnil;
1037 #endif /* HAVE_NS */
1039 ptrdiff_t
1040 menu_item_width (const unsigned char *str)
1042 ptrdiff_t len;
1043 const unsigned char *p;
1045 for (len = 0, p = str; *p; )
1047 int ch_len;
1048 int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
1050 len += CHAR_WIDTH (ch);
1051 p += ch_len;
1053 return len;
1056 DEFUN ("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.
1059 X and Y are frame-relative pixel coordinates, assumed to define
1060 a location within the menu bar.
1061 If FRAME is nil or omitted, it defaults to the selected frame.
1063 Value is the symbol of the menu at X/Y, or nil if the specified
1064 coordinates are not within the FRAME's menu bar. The symbol can
1065 be used to look up the menu like this:
1067 (lookup-key MAP [menu-bar SYMBOL])
1069 where MAP is either the current global map or the current local map,
1070 since menu-bar items come from both.
1072 This function can return non-nil only on a text-terminal frame
1073 or on an X frame that doesn't use any GUI toolkit. Otherwise,
1074 Emacs does not manage the menu bar and cannot convert coordinates
1075 into menu items. */)
1076 (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
1078 int row, col;
1079 struct frame *f = decode_any_frame (frame);
1081 if (!FRAME_LIVE_P (f))
1082 return Qnil;
1084 pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1);
1085 if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
1087 Lisp_Object items, item;
1088 int i;
1090 /* Find the menu bar item under `col'. */
1091 item = Qnil;
1092 items = FRAME_MENU_BAR_ITEMS (f);
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. */
1096 for (i = 0; i < ASIZE (items); i += 4)
1098 Lisp_Object pos, str;
1100 str = AREF (items, i + 1);
1101 pos = AREF (items, i + 3);
1102 if (NILP (str))
1103 return item;
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. */
1107 && col <= XINT (pos) + menu_item_width (SDATA (str)))
1109 item = AREF (items, i);
1110 return item;
1114 return Qnil;
1118 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1119 doc: /* Pop up a deck-of-cards menu and return user's selection.
1120 POSITION is a position specification. This is either a mouse button event
1121 or a list ((XOFFSET YOFFSET) WINDOW)
1122 where XOFFSET and YOFFSET are positions in pixels from the top left
1123 corner of WINDOW. (WINDOW may be a window or a frame object.)
1124 This controls the position of the top left of the menu as a whole.
1125 If POSITION is t, it means to use the current mouse position.
1127 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1128 The menu items come from key bindings that have a menu string as well as
1129 a 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
1131 the keymap as a top-level element.
1133 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1134 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1136 You can also use a list of keymaps as MENU.
1137 Then each keymap makes a separate pane.
1139 When MENU is a keymap or a list of keymaps, the return value is the
1140 list of events corresponding to the user's choice. Note that
1141 `x-popup-menu' does not actually execute the command bound to that
1142 sequence of events.
1144 Alternatively, you can specify a menu of multiple panes
1145 with a list of the form (TITLE PANE1 PANE2...),
1146 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1147 Each ITEM is normally a cons cell (STRING . VALUE);
1148 but a string can appear as an item--that makes a nonselectable line
1149 in the menu.
1150 With this form of menu, the return value is VALUE from the chosen item.
1152 If POSITION is nil, don't display the menu at all, just precalculate the
1153 cached information about equivalent key sequences.
1155 If the user gets rid of the menu without making a valid choice, for
1156 instance by clicking the mouse away from a valid choice or by typing
1157 keyboard input, then this normally results in a quit and
1158 `x-popup-menu' does not return. But if POSITION is a mouse button
1159 event (indicating that the user invoked the menu with the mouse) then
1160 no quit occurs and `x-popup-menu' returns nil. */)
1161 (Lisp_Object position, Lisp_Object menu)
1163 Lisp_Object keymap, tem, tem2;
1164 int xpos = 0, ypos = 0;
1165 Lisp_Object title;
1166 const char *error_name = NULL;
1167 Lisp_Object selection = Qnil;
1168 struct frame *f = NULL;
1169 Lisp_Object x, y, window;
1170 bool keymaps = 0;
1171 bool for_click = 0;
1172 bool kbd_menu_navigation = 0;
1173 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1174 struct gcpro gcpro1;
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;
1182 bool get_current_pos_p = 0;
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))))
1189 get_current_pos_p = 1;
1191 else
1193 tem = Fcar (position);
1194 if (CONSP (tem))
1196 window = Fcar (Fcdr (position));
1197 x = XCAR (tem);
1198 y = Fcar (XCDR (tem));
1200 else
1202 for_click = 1;
1203 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1204 window = Fcar (tem); /* POSN_WINDOW (tem) */
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;
1221 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1222 x = Fcar (tem);
1223 y = Fcdr (tem);
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;
1235 if (get_current_pos_p)
1237 /* Use the mouse's current position. */
1238 struct frame *new_f = SELECTED_FRAME ();
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)
1245 int cur_x, cur_y;
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);
1253 #else /* not HAVE_X_WINDOWS */
1254 Lisp_Object bar_window;
1255 enum scroll_bar_part part;
1256 Time time;
1257 void (*mouse_position_hook) (struct frame **, int,
1258 Lisp_Object *,
1259 enum scroll_bar_part *,
1260 Lisp_Object *,
1261 Lisp_Object *,
1262 Time *) =
1263 FRAME_TERMINAL (new_f)->mouse_position_hook;
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 */
1270 if (new_f != 0)
1271 XSETFRAME (window, new_f);
1272 else
1274 window = selected_window;
1275 XSETFASTINT (x, 0);
1276 XSETFASTINT (y, 0);
1280 /* Decode where to put the menu. */
1282 if (FRAMEP (window))
1284 f = XFRAME (window);
1285 xpos = 0;
1286 ypos = 0;
1288 else if (WINDOWP (window))
1290 struct window *win = XWINDOW (window);
1291 CHECK_LIVE_WINDOW (window);
1292 f = XFRAME (WINDOW_FRAME (win));
1294 xpos = WINDOW_LEFT_EDGE_X (win);
1295 ypos = WINDOW_TOP_EDGE_Y (win);
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);
1302 CHECK_RANGED_INTEGER (x,
1303 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1304 ? (EMACS_INT) INT_MIN - xpos
1305 : MOST_NEGATIVE_FIXNUM),
1306 INT_MAX - xpos);
1307 CHECK_RANGED_INTEGER (y,
1308 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1309 ? (EMACS_INT) INT_MIN - ypos
1310 : MOST_NEGATIVE_FIXNUM),
1311 INT_MAX - ypos);
1312 xpos += XINT (x);
1313 ypos += XINT (y);
1315 XSETFRAME (Vmenu_updating_frame, f);
1318 /* Now parse the lisp menus. */
1319 record_unwind_protect_void (unuse_menu_items);
1321 title = Qnil;
1322 GCPRO1 (title);
1324 /* Decode the menu items from what was specified. */
1326 keymap = get_keymap (menu, 0, 0);
1327 if (CONSP (keymap))
1329 /* We were given a keymap. Extract menu info from the keymap. */
1330 Lisp_Object prompt;
1332 /* Extract the detailed info to make one pane. */
1333 keymap_panes (&menu, 1);
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
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);
1349 keymaps = 1;
1351 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1353 /* We were given a list of keymaps. */
1354 EMACS_INT nmaps = XFASTINT (Flength (menu));
1355 Lisp_Object *maps;
1356 ptrdiff_t i;
1357 USE_SAFE_ALLOCA;
1359 SAFE_ALLOCA_LISP (maps, nmaps);
1360 title = Qnil;
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))
1366 Lisp_Object prompt;
1368 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1370 prompt = Fkeymap_prompt (keymap);
1371 if (NILP (title) && !NILP (prompt))
1372 title = prompt;
1375 /* Extract the detailed info to make one pane. */
1376 keymap_panes (maps, nmaps);
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);
1382 keymaps = 1;
1384 SAFE_FREE ();
1386 else
1388 /* We were given an old-fashioned menu. */
1389 title = Fcar (menu);
1390 CHECK_STRING (title);
1392 list_of_panes (Fcdr (menu));
1394 keymaps = 0;
1397 unbind_to (specpdl_count, Qnil);
1399 #ifdef HAVE_WINDOW_SYSTEM
1400 /* Hide a previous tip, if any. */
1401 if (!FRAME_TERMCAP_P (f))
1402 Fx_hide_tip ();
1403 #endif
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.
1411 if (current_popup_menu && FRAME_W32_P (f))
1413 discard_menu_items ();
1414 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1415 UNGCPRO;
1416 return Qnil;
1418 #endif
1420 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1421 record_unwind_protect_void (discard_menu_items);
1422 #endif
1424 /* Display them in a menu. */
1426 /* FIXME: Use a terminal hook! */
1427 #if defined HAVE_NTGUI
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))
1440 if (FRAME_X_P (f) || FRAME_MSDOS_P (f))
1441 selection = xmenu_show (f, xpos, ypos, for_click,
1442 keymaps, title, &error_name);
1443 else
1444 #endif
1445 if (FRAME_TERMCAP_P (f))
1447 ptrdiff_t count1 = SPECPDL_INDEX ();
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);
1457 #ifdef HAVE_NS
1458 unbind_to (specpdl_count, Qnil);
1459 #else
1460 discard_menu_items ();
1461 #endif
1463 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1464 if (FRAME_W32_P (f))
1465 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1466 #endif
1468 UNGCPRO;
1470 if (error_name) error ("%s", error_name);
1471 return selection;
1474 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
1475 doc: /* Pop up a dialog box and return user's selection.
1476 POSITION specifies which frame to use.
1477 This is normally a mouse button event or a window or frame.
1478 If POSITION is t, it means to use the frame the mouse is on.
1479 The dialog box appears in the middle of the specified frame.
1481 CONTENTS specifies the alternatives to display in the dialog box.
1482 It is a list of the form (DIALOG ITEM1 ITEM2...).
1483 Each ITEM is a cons cell (STRING . VALUE).
1484 The return value is VALUE from the chosen item.
1486 An ITEM may also be just a string--that makes a nonselectable item.
1487 An ITEM may also be nil--that means to put all preceding items
1488 on the left of the dialog box and all following items on the right.
1489 \(By default, approximately half appear on each side.)
1491 If HEADER is non-nil, the frame title for the box is "Information",
1492 otherwise it is "Question".
1494 If the user gets rid of the dialog box without making a valid choice,
1495 for 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)
1499 struct frame *f = NULL;
1500 Lisp_Object window;
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))))
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;
1515 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1517 if (new_f != 0)
1518 XSETFRAME (window, new_f);
1519 else
1520 window = selected_window;
1521 #endif
1522 window = selected_window;
1524 else if (CONSP (position))
1526 Lisp_Object tem = XCAR (position);
1527 if (CONSP (tem))
1528 window = Fcar (XCDR (position));
1529 else
1531 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
1532 window = Fcar (tem); /* POSN_WINDOW (tem) */
1535 else if (WINDOWP (position) || FRAMEP (position))
1536 window = position;
1537 else
1538 window = Qnil;
1540 /* Decode where to put the menu. */
1542 if (FRAMEP (window))
1543 f = XFRAME (window);
1544 else if (WINDOWP (window))
1546 CHECK_LIVE_WINDOW (window);
1547 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
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);
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.
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);
1565 #if defined USE_X_TOOLKIT || defined USE_GTK
1566 if (FRAME_WINDOW_P (f))
1567 return xw_popup_dialog (f, header, contents);
1568 #endif
1569 #ifdef HAVE_NTGUI
1570 if (FRAME_W32_P (f))
1572 Lisp_Object selection = w32_popup_dialog (f, header, contents);
1574 if (!EQ (selection, Qunsupported__w32_dialog))
1575 return selection;
1577 #endif
1578 #ifdef HAVE_NS
1579 if (FRAME_NS_P (f))
1580 return ns_popup_dialog (position, header, contents);
1581 #endif
1582 /* Display a menu with these alternatives
1583 in the middle of frame F. */
1585 Lisp_Object x, y, frame, newpos, prompt;
1586 int x_coord, y_coord;
1588 prompt = Fcar (contents);
1589 if (FRAME_WINDOW_P (f))
1591 x_coord = FRAME_PIXEL_WIDTH (f);
1592 y_coord = FRAME_PIXEL_HEIGHT (f);
1594 else
1596 x_coord = FRAME_COLS (f);
1597 /* Center the title at frame middle. (TTY menus have their
1598 upper-left corner at the given position.) */
1599 if (STRINGP (prompt))
1600 x_coord -= SCHARS (prompt);
1601 y_coord = FRAME_LINES (f);
1603 XSETFRAME (frame, f);
1604 XSETINT (x, x_coord / 2);
1605 XSETINT (y, y_coord / 2);
1606 newpos = list2 (list2 (x, y), frame);
1608 return Fx_popup_menu (newpos, list2 (prompt, contents));
1612 void
1613 syms_of_menu (void)
1615 staticpro (&menu_items);
1616 menu_items = Qnil;
1617 menu_items_inuse = Qnil;
1619 defsubr (&Sx_popup_menu);
1620 defsubr (&Sx_popup_dialog);
1621 defsubr (&Smenu_bar_menu_at_x_y);