* net/tramp-adb.el (tramp-adb-handle-process-file): Do not raise
[emacs.git] / src / menu.c
blob654be0db9c7cbbdbe9f98ae9100f8016f06e2616
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 || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame)))
420 && !NILP (map))
421 /* Indicate visually that this is a submenu. */
422 item_string = concat2 (item_string, build_string (" >"));
424 push_menu_item (item_string, enabled, key,
425 AREF (item_properties, ITEM_PROPERTY_DEF),
426 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
427 AREF (item_properties, ITEM_PROPERTY_TYPE),
428 AREF (item_properties, ITEM_PROPERTY_SELECTED),
429 AREF (item_properties, ITEM_PROPERTY_HELP));
431 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
432 /* Display a submenu using the toolkit. */
433 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
434 && ! (NILP (map) || NILP (enabled)))
436 push_submenu_start ();
437 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
438 push_submenu_end ();
440 #endif
443 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
444 and generate menu panes for them in menu_items. */
446 static void
447 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
449 ptrdiff_t mapno;
451 init_menu_items ();
453 /* Loop over the given keymaps, making a pane for each map.
454 But don't make a pane that is empty--ignore that map instead.
455 P is the number of panes we have made so far. */
456 for (mapno = 0; mapno < nmaps; mapno++)
457 single_keymap_panes (keymaps[mapno],
458 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
460 finish_menu_items ();
463 /* Encode a menu string as appropriate for menu-updating-frame's type. */
464 static Lisp_Object
465 encode_menu_string (Lisp_Object str)
467 /* TTY menu strings are encoded by write_glyphs, when they are
468 delivered to the glass, so no need to encode them here. */
469 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)))
470 return str;
471 return ENCODE_MENU_STRING (str);
474 /* Push the items in a single pane defined by the alist PANE. */
475 static void
476 list_of_items (Lisp_Object pane)
478 Lisp_Object tail, item, item1;
480 for (tail = pane; CONSP (tail); tail = XCDR (tail))
482 item = XCAR (tail);
483 if (STRINGP (item))
484 push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt,
485 Qnil, Qnil, Qnil, Qnil);
486 else if (CONSP (item))
488 item1 = XCAR (item);
489 CHECK_STRING (item1);
490 push_menu_item (encode_menu_string (item1), Qt, XCDR (item),
491 Qt, Qnil, Qnil, Qnil, Qnil);
493 else
494 push_left_right_boundary ();
499 /* Push all the panes and items of a menu described by the
500 alist-of-alists MENU.
501 This handles old-fashioned calls to x-popup-menu. */
502 void
503 list_of_panes (Lisp_Object menu)
505 Lisp_Object tail;
507 init_menu_items ();
509 for (tail = menu; CONSP (tail); tail = XCDR (tail))
511 Lisp_Object elt, pane_name, pane_data;
512 elt = XCAR (tail);
513 pane_name = Fcar (elt);
514 CHECK_STRING (pane_name);
515 push_menu_pane (encode_menu_string (pane_name), Qnil);
516 pane_data = Fcdr (elt);
517 CHECK_CONS (pane_data);
518 list_of_items (pane_data);
521 finish_menu_items ();
524 /* Set up data in menu_items for a menu bar item
525 whose event type is ITEM_KEY (with string ITEM_NAME)
526 and whose contents come from the list of keymaps MAPS. */
527 bool
528 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
529 Lisp_Object maps)
531 Lisp_Object length;
532 EMACS_INT len;
533 Lisp_Object *mapvec;
534 ptrdiff_t i;
535 bool top_level_items = 0;
536 USE_SAFE_ALLOCA;
538 length = Flength (maps);
539 len = XINT (length);
541 /* Convert the list MAPS into a vector MAPVEC. */
542 SAFE_ALLOCA_LISP (mapvec, len);
543 for (i = 0; i < len; i++)
545 mapvec[i] = Fcar (maps);
546 maps = Fcdr (maps);
549 /* Loop over the given keymaps, making a pane for each map.
550 But don't make a pane that is empty--ignore that map instead. */
551 for (i = 0; i < len; i++)
553 if (!KEYMAPP (mapvec[i]))
555 /* Here we have a command at top level in the menu bar
556 as opposed to a submenu. */
557 top_level_items = 1;
558 push_menu_pane (Qnil, Qnil);
559 push_menu_item (item_name, Qt, item_key, mapvec[i],
560 Qnil, Qnil, Qnil, Qnil);
562 else
564 Lisp_Object prompt;
565 prompt = Fkeymap_prompt (mapvec[i]);
566 single_keymap_panes (mapvec[i],
567 !NILP (prompt) ? prompt : item_name,
568 item_key, 10);
572 SAFE_FREE ();
573 return top_level_items;
577 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
579 /* Allocate a widget_value, blocking input. */
581 widget_value *
582 xmalloc_widget_value (void)
584 widget_value *value;
586 block_input ();
587 value = malloc_widget_value ();
588 unblock_input ();
590 return value;
593 /* This recursively calls free_widget_value on the tree of widgets.
594 It must free all data that was malloc'ed for these widget_values.
595 In Emacs, many slots are pointers into the data of Lisp_Strings, and
596 must be left alone. */
598 void
599 free_menubar_widget_value_tree (widget_value *wv)
601 if (! wv) return;
603 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
605 if (wv->contents && (wv->contents != (widget_value*)1))
607 free_menubar_widget_value_tree (wv->contents);
608 wv->contents = (widget_value *) 0xDEADBEEF;
610 if (wv->next)
612 free_menubar_widget_value_tree (wv->next);
613 wv->next = (widget_value *) 0xDEADBEEF;
615 block_input ();
616 free_widget_value (wv);
617 unblock_input ();
620 /* Create a tree of widget_value objects
621 representing the panes and items
622 in menu_items starting at index START, up to index END. */
624 widget_value *
625 digest_single_submenu (int start, int end, bool top_level_items)
627 widget_value *wv, *prev_wv, *save_wv, *first_wv;
628 int i;
629 int submenu_depth = 0;
630 widget_value **submenu_stack;
631 bool panes_seen = 0;
632 struct frame *f = XFRAME (Vmenu_updating_frame);
634 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
635 wv = xmalloc_widget_value ();
636 wv->name = "menu";
637 wv->value = 0;
638 wv->enabled = 1;
639 wv->button_type = BUTTON_TYPE_NONE;
640 wv->help = Qnil;
641 first_wv = wv;
642 save_wv = 0;
643 prev_wv = 0;
645 /* Loop over all panes and items made by the preceding call
646 to parse_single_submenu and construct a tree of widget_value objects.
647 Ignore the panes and items used by previous calls to
648 digest_single_submenu, even though those are also in menu_items. */
649 i = start;
650 while (i < end)
652 if (EQ (AREF (menu_items, i), Qnil))
654 submenu_stack[submenu_depth++] = save_wv;
655 save_wv = prev_wv;
656 prev_wv = 0;
657 i++;
659 else if (EQ (AREF (menu_items, i), Qlambda))
661 prev_wv = save_wv;
662 save_wv = submenu_stack[--submenu_depth];
663 i++;
665 else if (EQ (AREF (menu_items, i), Qt)
666 && submenu_depth != 0)
667 i += MENU_ITEMS_PANE_LENGTH;
668 /* Ignore a nil in the item list.
669 It's meaningful only for dialog boxes. */
670 else if (EQ (AREF (menu_items, i), Qquote))
671 i += 1;
672 else if (EQ (AREF (menu_items, i), Qt))
674 /* Create a new pane. */
675 Lisp_Object pane_name;
676 const char *pane_string;
678 panes_seen = 1;
680 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
682 /* TTY menus display menu items via tty_write_glyphs, which
683 will encode the strings as appropriate. */
684 if (!FRAME_TERMCAP_P (f))
686 #ifdef HAVE_NTGUI
687 if (STRINGP (pane_name))
689 if (unicode_append_menu)
690 /* Encode as UTF-8 for now. */
691 pane_name = ENCODE_UTF_8 (pane_name);
692 else if (STRING_MULTIBYTE (pane_name))
693 pane_name = ENCODE_SYSTEM (pane_name);
695 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
697 #elif defined (USE_LUCID) && defined (HAVE_XFT)
698 if (STRINGP (pane_name))
700 pane_name = ENCODE_UTF_8 (pane_name);
701 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
703 #elif !defined (HAVE_MULTILINGUAL_MENU)
704 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
706 pane_name = ENCODE_MENU_STRING (pane_name);
707 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
709 #endif
712 pane_string = (NILP (pane_name)
713 ? "" : SSDATA (pane_name));
714 /* If there is just one top-level pane, put all its items directly
715 under the top-level menu. */
716 if (menu_items_n_panes == 1)
717 pane_string = "";
719 /* If the pane has a meaningful name,
720 make the pane a top-level menu item
721 with its items as a submenu beneath it. */
722 if (strcmp (pane_string, ""))
724 wv = xmalloc_widget_value ();
725 if (save_wv)
726 save_wv->next = wv;
727 else
728 first_wv->contents = wv;
729 wv->lname = pane_name;
730 /* Set value to 1 so update_submenu_strings can handle '@' */
731 wv->value = (char *)1;
732 wv->enabled = 1;
733 wv->button_type = BUTTON_TYPE_NONE;
734 wv->help = Qnil;
735 save_wv = wv;
737 else
738 save_wv = first_wv;
740 prev_wv = 0;
741 i += MENU_ITEMS_PANE_LENGTH;
743 else
745 /* Create a new item within current pane. */
746 Lisp_Object item_name, enable, descrip, def, type, selected;
747 Lisp_Object help;
749 /* All items should be contained in panes. */
750 if (! panes_seen)
751 emacs_abort ();
753 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
754 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
755 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
756 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
757 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
758 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
759 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
761 /* TTY menu items and their descriptions will be encoded by
762 tty_write_glyphs. */
763 if (!FRAME_TERMCAP_P (f))
765 #ifdef HAVE_NTGUI
766 if (STRINGP (item_name))
768 if (unicode_append_menu)
769 item_name = ENCODE_UTF_8 (item_name);
770 else if (STRING_MULTIBYTE (item_name))
771 item_name = ENCODE_SYSTEM (item_name);
773 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
776 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
778 descrip = ENCODE_SYSTEM (descrip);
779 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
781 #elif USE_LUCID
782 if (STRINGP (item_name))
784 item_name = ENCODE_UTF_8 (item_name);
785 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
788 if (STRINGP (descrip))
790 descrip = ENCODE_UTF_8 (descrip);
791 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
793 #elif !defined (HAVE_MULTILINGUAL_MENU)
794 if (STRING_MULTIBYTE (item_name))
796 item_name = ENCODE_MENU_STRING (item_name);
797 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
800 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
802 descrip = ENCODE_MENU_STRING (descrip);
803 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
805 #endif
808 wv = xmalloc_widget_value ();
809 if (prev_wv)
810 prev_wv->next = wv;
811 else
812 save_wv->contents = wv;
814 wv->lname = item_name;
815 if (!NILP (descrip))
816 wv->lkey = descrip;
817 wv->value = 0;
818 /* The intptr_t cast avoids a warning. There's no problem
819 as long as pointers have enough bits to hold small integers. */
820 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
821 wv->enabled = !NILP (enable);
823 if (NILP (type))
824 wv->button_type = BUTTON_TYPE_NONE;
825 else if (EQ (type, QCradio))
826 wv->button_type = BUTTON_TYPE_RADIO;
827 else if (EQ (type, QCtoggle))
828 wv->button_type = BUTTON_TYPE_TOGGLE;
829 else
830 emacs_abort ();
832 wv->selected = !NILP (selected);
833 if (! STRINGP (help))
834 help = Qnil;
836 wv->help = help;
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->contents;
849 free_widget_value (first_wv);
850 return wv;
853 return first_wv;
856 /* Walk through the widget_value tree starting at FIRST_WV and update
857 the char * pointers from the corresponding lisp values.
858 We do this after building the whole tree, since GC may happen while the
859 tree is constructed, and small strings are relocated. So we must wait
860 until no GC can happen before storing pointers into lisp values. */
861 void
862 update_submenu_strings (widget_value *first_wv)
864 widget_value *wv;
866 for (wv = first_wv; wv; wv = wv->next)
868 if (STRINGP (wv->lname))
870 wv->name = SSDATA (wv->lname);
872 /* Ignore the @ that means "separate pane".
873 This is a kludge, but this isn't worth more time. */
874 if (wv->value == (char *)1)
876 if (wv->name[0] == '@')
877 wv->name++;
878 wv->value = 0;
882 if (STRINGP (wv->lkey))
883 wv->key = SSDATA (wv->lkey);
885 if (wv->contents)
886 update_submenu_strings (wv->contents);
890 /* Find the menu selection and store it in the keyboard buffer.
891 F is the frame the menu is on.
892 MENU_BAR_ITEMS_USED is the length of VECTOR.
893 VECTOR is an array of menu events for the whole menu. */
895 void
896 find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
897 Lisp_Object vector, void *client_data)
899 Lisp_Object prefix, entry;
900 Lisp_Object *subprefix_stack;
901 int submenu_depth = 0;
902 int i;
904 entry = Qnil;
905 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
906 prefix = Qnil;
907 i = 0;
909 while (i < menu_bar_items_used)
911 if (EQ (AREF (vector, i), Qnil))
913 subprefix_stack[submenu_depth++] = prefix;
914 prefix = entry;
915 i++;
917 else if (EQ (AREF (vector, i), Qlambda))
919 prefix = subprefix_stack[--submenu_depth];
920 i++;
922 else if (EQ (AREF (vector, i), Qt))
924 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
925 i += MENU_ITEMS_PANE_LENGTH;
927 else
929 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
930 /* Treat the pointer as an integer. There's no problem
931 as long as pointers have enough bits to hold small integers. */
932 if ((intptr_t) client_data == i)
934 int j;
935 struct input_event buf;
936 Lisp_Object frame;
937 EVENT_INIT (buf);
939 XSETFRAME (frame, f);
940 buf.kind = MENU_BAR_EVENT;
941 buf.frame_or_window = frame;
942 buf.arg = frame;
943 kbd_buffer_store_event (&buf);
945 for (j = 0; j < submenu_depth; j++)
946 if (!NILP (subprefix_stack[j]))
948 buf.kind = MENU_BAR_EVENT;
949 buf.frame_or_window = frame;
950 buf.arg = subprefix_stack[j];
951 kbd_buffer_store_event (&buf);
954 if (!NILP (prefix))
956 buf.kind = MENU_BAR_EVENT;
957 buf.frame_or_window = frame;
958 buf.arg = prefix;
959 kbd_buffer_store_event (&buf);
962 buf.kind = MENU_BAR_EVENT;
963 buf.frame_or_window = frame;
964 buf.arg = entry;
965 kbd_buffer_store_event (&buf);
967 return;
969 i += MENU_ITEMS_ITEM_LENGTH;
974 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
976 #ifdef HAVE_NS
977 /* As above, but return the menu selection instead of storing in kb buffer.
978 If KEYMAPS, return full prefixes to selection. */
979 Lisp_Object
980 find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
982 Lisp_Object prefix, entry;
983 int i;
984 Lisp_Object *subprefix_stack;
985 int submenu_depth = 0;
987 prefix = entry = Qnil;
988 i = 0;
989 subprefix_stack = alloca (menu_items_used * word_size);
991 while (i < menu_items_used)
993 if (EQ (AREF (menu_items, i), Qnil))
995 subprefix_stack[submenu_depth++] = prefix;
996 prefix = entry;
997 i++;
999 else if (EQ (AREF (menu_items, i), Qlambda))
1001 prefix = subprefix_stack[--submenu_depth];
1002 i++;
1004 else if (EQ (AREF (menu_items, i), Qt))
1006 prefix
1007 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1008 i += MENU_ITEMS_PANE_LENGTH;
1010 /* Ignore a nil in the item list.
1011 It's meaningful only for dialog boxes. */
1012 else if (EQ (AREF (menu_items, i), Qquote))
1013 i += 1;
1014 else
1016 entry
1017 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1018 if (aref_addr (menu_items, i) == client_data)
1020 if (keymaps)
1022 int j;
1024 entry = list1 (entry);
1025 if (!NILP (prefix))
1026 entry = Fcons (prefix, entry);
1027 for (j = submenu_depth - 1; j >= 0; j--)
1028 if (!NILP (subprefix_stack[j]))
1029 entry = Fcons (subprefix_stack[j], entry);
1031 return entry;
1033 i += MENU_ITEMS_ITEM_LENGTH;
1036 return Qnil;
1038 #endif /* HAVE_NS */
1040 ptrdiff_t
1041 menu_item_width (const unsigned char *str)
1043 ptrdiff_t len;
1044 const unsigned char *p;
1046 for (len = 0, p = str; *p; )
1048 int ch_len;
1049 int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
1051 len += CHAR_WIDTH (ch);
1052 p += ch_len;
1054 return len;
1057 DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y,
1058 2, 3, 0,
1059 doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y.
1060 X and Y are frame-relative pixel coordinates, assumed to define
1061 a location within the menu bar.
1062 If FRAME is nil or omitted, it defaults to the selected frame.
1064 Value is the symbol of the menu at X/Y, or nil if the specified
1065 coordinates are not within the FRAME's menu bar. The symbol can
1066 be used to look up the menu like this:
1068 (lookup-key MAP [menu-bar SYMBOL])
1070 where MAP is either the current global map or the current local map,
1071 since menu-bar items come from both.
1073 This function can return non-nil only on a text-terminal frame
1074 or on an X frame that doesn't use any GUI toolkit. Otherwise,
1075 Emacs does not manage the menu bar and cannot convert coordinates
1076 into menu items. */)
1077 (Lisp_Object x, Lisp_Object y, Lisp_Object frame)
1079 int row, col;
1080 struct frame *f = decode_any_frame (frame);
1082 if (!FRAME_LIVE_P (f))
1083 return Qnil;
1085 pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1);
1086 if (0 <= row && row < FRAME_MENU_BAR_LINES (f))
1088 Lisp_Object items, item;
1089 int i;
1091 /* Find the menu bar item under `col'. */
1092 item = Qnil;
1093 items = FRAME_MENU_BAR_ITEMS (f);
1094 /* This loop assumes a single menu-bar line, and will fail to
1095 find an item if it is not in the first line. Note that
1096 make_lispy_event in keyboard.c makes the same assumption. */
1097 for (i = 0; i < ASIZE (items); i += 4)
1099 Lisp_Object pos, str;
1101 str = AREF (items, i + 1);
1102 pos = AREF (items, i + 3);
1103 if (NILP (str))
1104 return item;
1105 if (XINT (pos) <= col
1106 /* We use <= so the blank between 2 items on a TTY is
1107 considered part of the previous item. */
1108 && col <= XINT (pos) + menu_item_width (SDATA (str)))
1110 item = AREF (items, i);
1111 return item;
1115 return Qnil;
1119 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1120 doc: /* Pop up a deck-of-cards menu and return user's selection.
1121 POSITION is a position specification. This is either a mouse button event
1122 or a list ((XOFFSET YOFFSET) WINDOW)
1123 where XOFFSET and YOFFSET are positions in pixels from the top left
1124 corner of WINDOW. (WINDOW may be a window or a frame object.)
1125 This controls the position of the top left of the menu as a whole.
1126 If POSITION is t, it means to use the current mouse position.
1128 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1129 The menu items come from key bindings that have a menu string as well as
1130 a definition; actually, the "definition" in such a key binding looks like
1131 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1132 the keymap as a top-level element.
1134 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1135 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1137 You can also use a list of keymaps as MENU.
1138 Then each keymap makes a separate pane.
1140 When MENU is a keymap or a list of keymaps, the return value is the
1141 list of events corresponding to the user's choice. Note that
1142 `x-popup-menu' does not actually execute the command bound to that
1143 sequence of events.
1145 Alternatively, you can specify a menu of multiple panes
1146 with a list of the form (TITLE PANE1 PANE2...),
1147 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1148 Each ITEM is normally a cons cell (STRING . VALUE);
1149 but a string can appear as an item--that makes a nonselectable line
1150 in the menu.
1151 With this form of menu, the return value is VALUE from the chosen item.
1153 If POSITION is nil, don't display the menu at all, just precalculate the
1154 cached information about equivalent key sequences.
1156 If the user gets rid of the menu without making a valid choice, for
1157 instance by clicking the mouse away from a valid choice or by typing
1158 keyboard input, then this normally results in a quit and
1159 `x-popup-menu' does not return. But if POSITION is a mouse button
1160 event (indicating that the user invoked the menu with the mouse) then
1161 no quit occurs and `x-popup-menu' returns nil. */)
1162 (Lisp_Object position, Lisp_Object menu)
1164 Lisp_Object keymap, tem, tem2;
1165 int xpos = 0, ypos = 0;
1166 Lisp_Object title;
1167 const char *error_name = NULL;
1168 Lisp_Object selection = Qnil;
1169 struct frame *f = NULL;
1170 Lisp_Object x, y, window;
1171 bool keymaps = 0;
1172 bool for_click = 0;
1173 bool kbd_menu_navigation = 0;
1174 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1175 struct gcpro gcpro1;
1177 if (NILP (position))
1178 /* This is an obsolete call, which wants us to precompute the
1179 keybinding equivalents, but we don't do that any more anyway. */
1180 return Qnil;
1183 bool get_current_pos_p = 0;
1185 /* Decode the first argument: find the window and the coordinates. */
1186 if (EQ (position, Qt)
1187 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1188 || EQ (XCAR (position), Qtool_bar))))
1190 get_current_pos_p = 1;
1192 else
1194 tem = Fcar (position);
1195 if (CONSP (tem))
1197 window = Fcar (Fcdr (position));
1198 x = XCAR (tem);
1199 y = Fcar (XCDR (tem));
1201 else
1203 for_click = 1;
1204 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1205 window = Fcar (tem); /* POSN_WINDOW (tem) */
1206 tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */
1207 /* The kbd_menu_navigation flag is set when the menu was
1208 invoked by F10, which probably means they have no
1209 mouse. In that case, we let them switch between
1210 top-level menu-bar menus by using C-f/C-b and
1211 horizontal arrow keys, since they cannot click the
1212 mouse to open a different submenu. This flag is only
1213 supported by tty_menu_show. We set it when POSITION
1214 and last_nonmenu_event are different, which means we
1215 constructed POSITION by hand (in popup-menu, see
1216 menu-bar.el) to look like a mouse click on the menu bar
1217 event. */
1218 if (!EQ (POSN_POSN (last_nonmenu_event),
1219 POSN_POSN (position))
1220 && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar))
1221 kbd_menu_navigation = 1;
1222 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1223 x = Fcar (tem);
1224 y = Fcdr (tem);
1227 /* If a click happens in an external tool bar or a detached
1228 tool bar, x and y is NIL. In that case, use the current
1229 mouse position. This happens for the help button in the
1230 tool bar. Ideally popup-menu should pass NIL to
1231 this function, but it doesn't. */
1232 if (NILP (x) && NILP (y))
1233 get_current_pos_p = 1;
1236 if (get_current_pos_p)
1238 /* Use the mouse's current position. */
1239 struct frame *new_f = SELECTED_FRAME ();
1240 #ifdef HAVE_X_WINDOWS
1241 /* Can't use mouse_position_hook for X since it returns
1242 coordinates relative to the window the mouse is in,
1243 we need coordinates relative to the edit widget always. */
1244 if (new_f != 0)
1246 int cur_x, cur_y;
1248 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1249 /* cur_x/y may be negative, so use make_number. */
1250 x = make_number (cur_x);
1251 y = make_number (cur_y);
1254 #else /* not HAVE_X_WINDOWS */
1255 Lisp_Object bar_window;
1256 enum scroll_bar_part part;
1257 Time time;
1258 void (*mouse_position_hook) (struct frame **, int,
1259 Lisp_Object *,
1260 enum scroll_bar_part *,
1261 Lisp_Object *,
1262 Lisp_Object *,
1263 Time *) =
1264 FRAME_TERMINAL (new_f)->mouse_position_hook;
1266 if (mouse_position_hook)
1267 (*mouse_position_hook) (&new_f, 1, &bar_window,
1268 &part, &x, &y, &time);
1269 #endif /* not HAVE_X_WINDOWS */
1271 if (new_f != 0)
1272 XSETFRAME (window, new_f);
1273 else
1275 window = selected_window;
1276 XSETFASTINT (x, 0);
1277 XSETFASTINT (y, 0);
1281 /* Decode where to put the menu. */
1283 if (FRAMEP (window))
1285 f = XFRAME (window);
1286 xpos = 0;
1287 ypos = 0;
1289 else if (WINDOWP (window))
1291 struct window *win = XWINDOW (window);
1292 CHECK_LIVE_WINDOW (window);
1293 f = XFRAME (WINDOW_FRAME (win));
1295 xpos = WINDOW_LEFT_EDGE_X (win);
1296 ypos = WINDOW_TOP_EDGE_Y (win);
1298 else
1299 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1300 but I don't want to make one now. */
1301 CHECK_WINDOW (window);
1303 CHECK_RANGED_INTEGER (x,
1304 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1305 ? (EMACS_INT) INT_MIN - xpos
1306 : MOST_NEGATIVE_FIXNUM),
1307 INT_MAX - xpos);
1308 CHECK_RANGED_INTEGER (y,
1309 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1310 ? (EMACS_INT) INT_MIN - ypos
1311 : MOST_NEGATIVE_FIXNUM),
1312 INT_MAX - ypos);
1313 xpos += XINT (x);
1314 ypos += XINT (y);
1316 XSETFRAME (Vmenu_updating_frame, f);
1319 /* Now parse the lisp menus. */
1320 record_unwind_protect_void (unuse_menu_items);
1322 title = Qnil;
1323 GCPRO1 (title);
1325 /* Decode the menu items from what was specified. */
1327 keymap = get_keymap (menu, 0, 0);
1328 if (CONSP (keymap))
1330 /* We were given a keymap. Extract menu info from the keymap. */
1331 Lisp_Object prompt;
1333 /* Extract the detailed info to make one pane. */
1334 keymap_panes (&menu, 1);
1336 /* Search for a string appearing directly as an element of the keymap.
1337 That string is the title of the menu. */
1338 prompt = Fkeymap_prompt (keymap);
1339 if (!NILP (prompt))
1340 title = prompt;
1341 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1342 else
1343 title = build_string ("Select");
1344 #endif
1346 /* Make that be the pane title of the first pane. */
1347 if (!NILP (prompt) && menu_items_n_panes >= 0)
1348 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1350 keymaps = 1;
1352 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1354 /* We were given a list of keymaps. */
1355 EMACS_INT nmaps = XFASTINT (Flength (menu));
1356 Lisp_Object *maps;
1357 ptrdiff_t i;
1358 USE_SAFE_ALLOCA;
1360 SAFE_ALLOCA_LISP (maps, nmaps);
1361 title = Qnil;
1363 /* The first keymap that has a prompt string
1364 supplies the menu title. */
1365 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1367 Lisp_Object prompt;
1369 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1371 prompt = Fkeymap_prompt (keymap);
1372 if (NILP (title) && !NILP (prompt))
1373 title = prompt;
1376 /* Extract the detailed info to make one pane. */
1377 keymap_panes (maps, nmaps);
1379 /* Make the title be the pane title of the first pane. */
1380 if (!NILP (title) && menu_items_n_panes >= 0)
1381 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1383 keymaps = 1;
1385 SAFE_FREE ();
1387 else
1389 /* We were given an old-fashioned menu. */
1390 title = Fcar (menu);
1391 CHECK_STRING (title);
1393 list_of_panes (Fcdr (menu));
1395 keymaps = 0;
1398 unbind_to (specpdl_count, Qnil);
1400 #ifdef HAVE_WINDOW_SYSTEM
1401 /* Hide a previous tip, if any. */
1402 if (!FRAME_TERMCAP_P (f))
1403 Fx_hide_tip ();
1404 #endif
1406 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1407 /* If resources from a previous popup menu still exist, does nothing
1408 until the `menu_free_timer' has freed them (see w32fns.c). This
1409 can occur if you press ESC or click outside a menu without selecting
1410 a menu item.
1412 if (current_popup_menu && FRAME_W32_P (f))
1414 discard_menu_items ();
1415 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1416 UNGCPRO;
1417 return Qnil;
1419 #endif
1421 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1422 record_unwind_protect_void (discard_menu_items);
1423 #endif
1425 /* Display them in a menu. */
1427 /* FIXME: Use a terminal hook! */
1428 #if defined HAVE_NTGUI
1429 if (FRAME_W32_P (f))
1430 selection = w32_menu_show (f, xpos, ypos, for_click,
1431 keymaps, title, &error_name);
1432 else
1433 #endif
1434 #if defined HAVE_NS
1435 if (FRAME_NS_P (f))
1436 selection = ns_menu_show (f, xpos, ypos, for_click,
1437 keymaps, title, &error_name);
1438 else
1439 #endif
1440 #if (defined (HAVE_X_WINDOWS) || defined (MSDOS))
1441 if (FRAME_X_P (f) || FRAME_MSDOS_P (f))
1442 selection = xmenu_show (f, xpos, ypos, for_click,
1443 keymaps, title, &error_name);
1444 else
1445 #endif
1446 #ifndef MSDOS
1447 if (FRAME_TERMCAP_P (f))
1449 ptrdiff_t count1 = SPECPDL_INDEX ();
1451 /* Avoid crashes if, e.g., another client will connect while we
1452 are in a menu. */
1453 temporarily_switch_to_single_kboard (f);
1454 selection = tty_menu_show (f, xpos, ypos, for_click, keymaps, title,
1455 kbd_menu_navigation, &error_name);
1456 unbind_to (count1, Qnil);
1458 #endif
1460 #ifdef HAVE_NS
1461 unbind_to (specpdl_count, Qnil);
1462 #else
1463 discard_menu_items ();
1464 #endif
1466 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1467 if (FRAME_W32_P (f))
1468 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1469 #endif
1471 UNGCPRO;
1473 if (error_name) error ("%s", error_name);
1474 return selection;
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))))
1510 #if 0 /* Using the frame the mouse is on may not be right. */
1511 /* Use the mouse's current position. */
1512 struct frame *new_f = SELECTED_FRAME ();
1513 Lisp_Object bar_window;
1514 enum scroll_bar_part part;
1515 Time time;
1516 Lisp_Object x, y;
1518 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1520 if (new_f != 0)
1521 XSETFRAME (window, new_f);
1522 else
1523 window = selected_window;
1524 #endif
1525 window = selected_window;
1527 else if (CONSP (position))
1529 Lisp_Object tem = XCAR (position);
1530 if (CONSP (tem))
1531 window = Fcar (XCDR (position));
1532 else
1534 tem = Fcar (XCDR (position)); /* EVENT_START (position) */
1535 window = Fcar (tem); /* POSN_WINDOW (tem) */
1538 else if (WINDOWP (position) || FRAMEP (position))
1539 window = position;
1540 else
1541 window = Qnil;
1543 /* Decode where to put the menu. */
1545 if (FRAMEP (window))
1546 f = XFRAME (window);
1547 else if (WINDOWP (window))
1549 CHECK_LIVE_WINDOW (window);
1550 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1552 else
1553 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1554 but I don't want to make one now. */
1555 CHECK_WINDOW (window);
1557 /* Note that xw_popup_dialog can call menu code, so
1558 Vmenu_updating_frame should be set (Bug#17891). */
1559 eassert (f && FRAME_LIVE_P (f));
1560 XSETFRAME (Vmenu_updating_frame, f);
1562 /* Force a redisplay before showing the dialog. If a frame is created
1563 just before showing the dialog, its contents may not have been fully
1564 drawn, as this depends on timing of events from the X server. Redisplay
1565 is not done when a dialog is shown. If redisplay could be done in the
1566 X event loop (i.e. the X event loop does not run in a signal handler)
1567 this would not be needed.
1569 Do this before creating the widget value that points to Lisp
1570 string contents, because Fredisplay may GC and relocate them. */
1571 Fredisplay (Qt);
1573 #if defined USE_X_TOOLKIT || defined USE_GTK
1574 if (FRAME_WINDOW_P (f))
1575 return xw_popup_dialog (f, header, contents);
1576 #endif
1577 #ifdef HAVE_NTGUI
1578 if (FRAME_W32_P (f))
1580 Lisp_Object selection = w32_popup_dialog (f, header, contents);
1582 if (!EQ (selection, Qunsupported__w32_dialog))
1583 return selection;
1585 #endif
1586 #ifdef HAVE_NS
1587 if (FRAME_NS_P (f))
1588 return ns_popup_dialog (position, header, contents);
1589 #endif
1590 /* Display a menu with these alternatives
1591 in the middle of frame F. */
1593 Lisp_Object x, y, frame, newpos, prompt;
1594 int x_coord, y_coord;
1596 prompt = Fcar (contents);
1597 if (FRAME_WINDOW_P (f))
1599 x_coord = FRAME_PIXEL_WIDTH (f);
1600 y_coord = FRAME_PIXEL_HEIGHT (f);
1602 else
1604 x_coord = FRAME_COLS (f);
1605 /* Center the title at frame middle. (TTY menus have their
1606 upper-left corner at the given position.) */
1607 if (STRINGP (prompt))
1608 x_coord -= SCHARS (prompt);
1609 y_coord = FRAME_LINES (f);
1611 XSETFRAME (frame, f);
1612 XSETINT (x, x_coord / 2);
1613 XSETINT (y, y_coord / 2);
1614 newpos = list2 (list2 (x, y), frame);
1616 return Fx_popup_menu (newpos, list2 (prompt, contents));
1620 void
1621 syms_of_menu (void)
1623 staticpro (&menu_items);
1624 menu_items = Qnil;
1625 menu_items_inuse = Qnil;
1627 defsubr (&Sx_popup_menu);
1628 defsubr (&Sx_popup_dialog);
1629 defsubr (&Smenu_bar_menu_at_x_y);