Merge from trunk.
[emacs.git] / src / menu.c
blob5ca687f3d8a0bd86b10408bfc354f50a0ecfb9a8
1 /* Platform-independent code for terminal communications.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2013 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"
34 #ifdef USE_X_TOOLKIT
35 #include "../lwlib/lwlib.h"
36 #endif
38 #ifdef HAVE_WINDOW_SYSTEM
39 #include TERM_HEADER
40 #endif /* HAVE_WINDOW_SYSTEM */
42 #ifdef HAVE_NTGUI
43 # ifdef NTGUI_UNICODE
44 # define unicode_append_menu AppendMenuW
45 # else /* !NTGUI_UNICODE */
46 extern AppendMenuW_Proc unicode_append_menu;
47 # endif /* NTGUI_UNICODE */
48 extern HMENU current_popup_menu;
49 #endif /* HAVE_NTGUI */
51 #include "menu.h"
53 /* Return non-zero if menus can handle radio and toggle buttons. */
54 static bool
55 have_boxes (void)
57 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
58 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)))
59 return 1;
60 #endif
61 return 0;
64 Lisp_Object menu_items;
66 /* If non-nil, means that the global vars defined here are already in use.
67 Used to detect cases where we try to re-enter this non-reentrant code. */
68 #if ! (defined USE_GTK || defined USE_MOTIF)
69 static
70 #endif
71 Lisp_Object menu_items_inuse;
73 /* Number of slots currently allocated in menu_items. */
74 int menu_items_allocated;
76 /* This is the index in menu_items of the first empty slot. */
77 int menu_items_used;
79 /* The number of panes currently recorded in menu_items,
80 excluding those within submenus. */
81 int menu_items_n_panes;
83 /* Current depth within submenus. */
84 static int menu_items_submenu_depth;
86 void
87 init_menu_items (void)
89 if (!NILP (menu_items_inuse))
90 error ("Trying to use a menu from within a menu-entry");
92 if (NILP (menu_items))
94 menu_items_allocated = 60;
95 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
98 menu_items_inuse = Qt;
99 menu_items_used = 0;
100 menu_items_n_panes = 0;
101 menu_items_submenu_depth = 0;
104 /* Call at the end of generating the data in menu_items. */
106 void
107 finish_menu_items (void)
111 void
112 unuse_menu_items (void)
114 menu_items_inuse = Qnil;
117 /* Call when finished using the data for the current menu
118 in menu_items. */
120 void
121 discard_menu_items (void)
123 /* Free the structure if it is especially large.
124 Otherwise, hold on to it, to save time. */
125 if (menu_items_allocated > 200)
127 menu_items = Qnil;
128 menu_items_allocated = 0;
130 eassert (NILP (menu_items_inuse));
133 /* This undoes save_menu_items, and it is called by the specpdl unwind
134 mechanism. */
136 static void
137 restore_menu_items (Lisp_Object saved)
139 menu_items = XCAR (saved);
140 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
141 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
142 saved = XCDR (saved);
143 menu_items_used = XINT (XCAR (saved));
144 saved = XCDR (saved);
145 menu_items_n_panes = XINT (XCAR (saved));
146 saved = XCDR (saved);
147 menu_items_submenu_depth = XINT (XCAR (saved));
150 /* Push the whole state of menu_items processing onto the specpdl.
151 It will be restored when the specpdl is unwound. */
153 void
154 save_menu_items (void)
156 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
157 make_number (menu_items_used),
158 make_number (menu_items_n_panes),
159 make_number (menu_items_submenu_depth));
160 record_unwind_protect (restore_menu_items, saved);
161 menu_items_inuse = Qnil;
162 menu_items = Qnil;
166 /* Ensure that there is room for ITEMS items in the menu_items vector. */
168 static void
169 ensure_menu_items (int items)
171 int incr = items - (menu_items_allocated - menu_items_used);
172 if (incr > 0)
174 menu_items = larger_vector (menu_items, incr, INT_MAX);
175 menu_items_allocated = ASIZE (menu_items);
179 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
180 || defined HAVE_NTGUI)
182 /* Begin a submenu. */
184 static void
185 push_submenu_start (void)
187 ensure_menu_items (1);
188 ASET (menu_items, menu_items_used, Qnil);
189 menu_items_used++;
190 menu_items_submenu_depth++;
193 /* End a submenu. */
195 static void
196 push_submenu_end (void)
198 ensure_menu_items (1);
199 ASET (menu_items, menu_items_used, Qlambda);
200 menu_items_used++;
201 menu_items_submenu_depth--;
204 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
206 /* Indicate boundary between left and right. */
208 static void
209 push_left_right_boundary (void)
211 ensure_menu_items (1);
212 ASET (menu_items, menu_items_used, Qquote);
213 menu_items_used++;
216 /* Start a new menu pane in menu_items.
217 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
219 static void
220 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
222 ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
223 if (menu_items_submenu_depth == 0)
224 menu_items_n_panes++;
225 ASET (menu_items, menu_items_used, Qt);
226 menu_items_used++;
227 ASET (menu_items, menu_items_used, name);
228 menu_items_used++;
229 ASET (menu_items, menu_items_used, prefix_vec);
230 menu_items_used++;
233 /* Push one menu item into the current pane. NAME is the string to
234 display. ENABLE if non-nil means this item can be selected. KEY
235 is the key generated by choosing this item, or nil if this item
236 doesn't really have a definition. DEF is the definition of this
237 item. EQUIV is the textual description of the keyboard equivalent
238 for this item (or nil if none). TYPE is the type of this menu
239 item, one of nil, `toggle' or `radio'. */
241 static void
242 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)
244 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
246 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
247 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
248 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
249 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
250 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
252 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
253 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
255 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
258 /* Args passed between single_keymap_panes and single_menu_item. */
259 struct skp
261 Lisp_Object pending_maps;
262 int maxdepth;
263 int notbuttons;
266 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
267 void *);
269 /* This is a recursive subroutine of keymap_panes.
270 It handles one keymap, KEYMAP.
271 The other arguments are passed along
272 or point to local variables of the previous function.
274 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
276 static void
277 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
278 Lisp_Object prefix, int maxdepth)
280 struct skp skp;
281 struct gcpro gcpro1;
283 skp.pending_maps = Qnil;
284 skp.maxdepth = maxdepth;
285 skp.notbuttons = 0;
287 if (maxdepth <= 0)
288 return;
290 push_menu_pane (pane_name, prefix);
292 if (!have_boxes ())
294 /* Remember index for first item in this pane so we can go back
295 and add a prefix when (if) we see the first button. After
296 that, notbuttons is set to 0, to mark that we have seen a
297 button and all non button items need a prefix. */
298 skp.notbuttons = menu_items_used;
301 GCPRO1 (skp.pending_maps);
302 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
303 UNGCPRO;
305 /* Process now any submenus which want to be panes at this level. */
306 while (CONSP (skp.pending_maps))
308 Lisp_Object elt, eltcdr, string;
309 elt = XCAR (skp.pending_maps);
310 eltcdr = XCDR (elt);
311 string = XCAR (eltcdr);
312 /* We no longer discard the @ from the beginning of the string here.
313 Instead, we do this in *menu_show. */
314 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
315 skp.pending_maps = XCDR (skp.pending_maps);
319 /* This is a subroutine of single_keymap_panes that handles one
320 keymap entry.
321 KEY is a key in a keymap and ITEM is its binding.
322 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
323 separate panes.
324 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
326 static void
327 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
329 Lisp_Object map, item_string, enabled;
330 struct gcpro gcpro1, gcpro2;
331 bool res;
332 struct skp *skp = skp_v;
334 /* Parse the menu item and leave the result in item_properties. */
335 GCPRO2 (key, item);
336 res = parse_menu_item (item, 0);
337 UNGCPRO;
338 if (!res)
339 return; /* Not a menu item. */
341 map = AREF (item_properties, ITEM_PROPERTY_MAP);
343 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
344 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
346 if (!NILP (map) && SREF (item_string, 0) == '@')
348 if (!NILP (enabled))
349 /* An enabled separate pane. Remember this to handle it later. */
350 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
351 skp->pending_maps);
352 return;
355 /* Simulate radio buttons and toggle boxes by putting a prefix in
356 front of them. */
357 if (!have_boxes ())
359 Lisp_Object prefix = Qnil;
360 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
361 if (!NILP (type))
363 Lisp_Object selected
364 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
366 if (skp->notbuttons)
367 /* The first button. Line up previous items in this menu. */
369 int idx = skp->notbuttons; /* Index for first item this menu. */
370 int submenu = 0;
371 Lisp_Object tem;
372 while (idx < menu_items_used)
375 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
376 if (NILP (tem))
378 idx++;
379 submenu++; /* Skip sub menu. */
381 else if (EQ (tem, Qlambda))
383 idx++;
384 submenu--; /* End sub menu. */
386 else if (EQ (tem, Qt))
387 idx += 3; /* Skip new pane marker. */
388 else if (EQ (tem, Qquote))
389 idx++; /* Skip a left, right divider. */
390 else
392 if (!submenu && SREF (tem, 0) != '\0'
393 && SREF (tem, 0) != '-')
394 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
395 concat2 (build_string (" "), tem));
396 idx += MENU_ITEMS_ITEM_LENGTH;
399 skp->notbuttons = 0;
402 /* Calculate prefix, if any, for this item. */
403 if (EQ (type, QCtoggle))
404 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
405 else if (EQ (type, QCradio))
406 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
408 /* Not a button. If we have earlier buttons, then we need a prefix. */
409 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
410 && SREF (item_string, 0) != '-')
411 prefix = build_string (" ");
413 if (!NILP (prefix))
414 item_string = concat2 (prefix, item_string);
417 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
418 && !NILP (map))
419 /* Indicate visually that this is a submenu. */
420 item_string = concat2 (item_string, build_string (" >"));
422 push_menu_item (item_string, enabled, key,
423 AREF (item_properties, ITEM_PROPERTY_DEF),
424 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
425 AREF (item_properties, ITEM_PROPERTY_TYPE),
426 AREF (item_properties, ITEM_PROPERTY_SELECTED),
427 AREF (item_properties, ITEM_PROPERTY_HELP));
429 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
430 /* Display a submenu using the toolkit. */
431 if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))
432 && ! (NILP (map) || NILP (enabled)))
434 push_submenu_start ();
435 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
436 push_submenu_end ();
438 #endif
441 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
442 and generate menu panes for them in menu_items. */
444 static void
445 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
447 ptrdiff_t mapno;
449 init_menu_items ();
451 /* Loop over the given keymaps, making a pane for each map.
452 But don't make a pane that is empty--ignore that map instead.
453 P is the number of panes we have made so far. */
454 for (mapno = 0; mapno < nmaps; mapno++)
455 single_keymap_panes (keymaps[mapno],
456 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
458 finish_menu_items ();
461 /* Encode a menu string as appropriate for menu-updating-frame's type. */
462 static Lisp_Object
463 encode_menu_string (Lisp_Object str)
465 /* TTY menu strings are encoded by write_glyphs, when they are
466 delivered to the glass, so no need to encode them here. */
467 if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)))
468 return str;
469 return ENCODE_MENU_STRING (str);
472 /* Push the items in a single pane defined by the alist PANE. */
473 static void
474 list_of_items (Lisp_Object pane)
476 Lisp_Object tail, item, item1;
478 for (tail = pane; CONSP (tail); tail = XCDR (tail))
480 item = XCAR (tail);
481 if (STRINGP (item))
482 push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt,
483 Qnil, Qnil, Qnil, Qnil);
484 else if (CONSP (item))
486 item1 = XCAR (item);
487 CHECK_STRING (item1);
488 push_menu_item (encode_menu_string (item1), Qt, XCDR (item),
489 Qt, Qnil, Qnil, Qnil, Qnil);
491 else
492 push_left_right_boundary ();
497 /* Push all the panes and items of a menu described by the
498 alist-of-alists MENU.
499 This handles old-fashioned calls to x-popup-menu. */
500 void
501 list_of_panes (Lisp_Object menu)
503 Lisp_Object tail;
505 init_menu_items ();
507 for (tail = menu; CONSP (tail); tail = XCDR (tail))
509 Lisp_Object elt, pane_name, pane_data;
510 elt = XCAR (tail);
511 pane_name = Fcar (elt);
512 CHECK_STRING (pane_name);
513 push_menu_pane (encode_menu_string (pane_name), Qnil);
514 pane_data = Fcdr (elt);
515 CHECK_CONS (pane_data);
516 list_of_items (pane_data);
519 finish_menu_items ();
522 /* Set up data in menu_items for a menu bar item
523 whose event type is ITEM_KEY (with string ITEM_NAME)
524 and whose contents come from the list of keymaps MAPS. */
525 bool
526 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
527 Lisp_Object maps)
529 Lisp_Object length;
530 EMACS_INT len;
531 Lisp_Object *mapvec;
532 ptrdiff_t i;
533 bool top_level_items = 0;
534 USE_SAFE_ALLOCA;
536 length = Flength (maps);
537 len = XINT (length);
539 /* Convert the list MAPS into a vector MAPVEC. */
540 SAFE_ALLOCA_LISP (mapvec, len);
541 for (i = 0; i < len; i++)
543 mapvec[i] = Fcar (maps);
544 maps = Fcdr (maps);
547 /* Loop over the given keymaps, making a pane for each map.
548 But don't make a pane that is empty--ignore that map instead. */
549 for (i = 0; i < len; i++)
551 if (!KEYMAPP (mapvec[i]))
553 /* Here we have a command at top level in the menu bar
554 as opposed to a submenu. */
555 top_level_items = 1;
556 push_menu_pane (Qnil, Qnil);
557 push_menu_item (item_name, Qt, item_key, mapvec[i],
558 Qnil, Qnil, Qnil, Qnil);
560 else
562 Lisp_Object prompt;
563 prompt = Fkeymap_prompt (mapvec[i]);
564 single_keymap_panes (mapvec[i],
565 !NILP (prompt) ? prompt : item_name,
566 item_key, 10);
570 SAFE_FREE ();
571 return top_level_items;
575 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
577 /* Allocate a widget_value, blocking input. */
579 widget_value *
580 xmalloc_widget_value (void)
582 widget_value *value;
584 block_input ();
585 value = malloc_widget_value ();
586 unblock_input ();
588 return value;
591 /* This recursively calls free_widget_value on the tree of widgets.
592 It must free all data that was malloc'ed for these widget_values.
593 In Emacs, many slots are pointers into the data of Lisp_Strings, and
594 must be left alone. */
596 void
597 free_menubar_widget_value_tree (widget_value *wv)
599 if (! wv) return;
601 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
603 if (wv->contents && (wv->contents != (widget_value*)1))
605 free_menubar_widget_value_tree (wv->contents);
606 wv->contents = (widget_value *) 0xDEADBEEF;
608 if (wv->next)
610 free_menubar_widget_value_tree (wv->next);
611 wv->next = (widget_value *) 0xDEADBEEF;
613 block_input ();
614 free_widget_value (wv);
615 unblock_input ();
618 /* Create a tree of widget_value objects
619 representing the panes and items
620 in menu_items starting at index START, up to index END. */
622 widget_value *
623 digest_single_submenu (int start, int end, bool top_level_items)
625 widget_value *wv, *prev_wv, *save_wv, *first_wv;
626 int i;
627 int submenu_depth = 0;
628 widget_value **submenu_stack;
629 bool panes_seen = 0;
630 struct frame *f = XFRAME (Vmenu_updating_frame);
632 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
633 wv = xmalloc_widget_value ();
634 wv->name = "menu";
635 wv->value = 0;
636 wv->enabled = 1;
637 wv->button_type = BUTTON_TYPE_NONE;
638 wv->help = Qnil;
639 first_wv = wv;
640 save_wv = 0;
641 prev_wv = 0;
643 /* Loop over all panes and items made by the preceding call
644 to parse_single_submenu and construct a tree of widget_value objects.
645 Ignore the panes and items used by previous calls to
646 digest_single_submenu, even though those are also in menu_items. */
647 i = start;
648 while (i < end)
650 if (EQ (AREF (menu_items, i), Qnil))
652 submenu_stack[submenu_depth++] = save_wv;
653 save_wv = prev_wv;
654 prev_wv = 0;
655 i++;
657 else if (EQ (AREF (menu_items, i), Qlambda))
659 prev_wv = save_wv;
660 save_wv = submenu_stack[--submenu_depth];
661 i++;
663 else if (EQ (AREF (menu_items, i), Qt)
664 && submenu_depth != 0)
665 i += MENU_ITEMS_PANE_LENGTH;
666 /* Ignore a nil in the item list.
667 It's meaningful only for dialog boxes. */
668 else if (EQ (AREF (menu_items, i), Qquote))
669 i += 1;
670 else if (EQ (AREF (menu_items, i), Qt))
672 /* Create a new pane. */
673 Lisp_Object pane_name;
674 const char *pane_string;
676 panes_seen = 1;
678 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
680 /* TTY menus display menu items via tty_write_glyphs, which
681 will encode the strings as appropriate. */
682 if (!FRAME_TERMCAP_P (f))
684 #ifdef HAVE_NTGUI
685 if (STRINGP (pane_name))
687 if (unicode_append_menu)
688 /* Encode as UTF-8 for now. */
689 pane_name = ENCODE_UTF_8 (pane_name);
690 else if (STRING_MULTIBYTE (pane_name))
691 pane_name = ENCODE_SYSTEM (pane_name);
693 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
695 #elif defined (USE_LUCID) && defined (HAVE_XFT)
696 if (STRINGP (pane_name))
698 pane_name = ENCODE_UTF_8 (pane_name);
699 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
701 #elif !defined (HAVE_MULTILINGUAL_MENU)
702 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
704 pane_name = ENCODE_MENU_STRING (pane_name);
705 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
707 #endif
710 pane_string = (NILP (pane_name)
711 ? "" : SSDATA (pane_name));
712 /* If there is just one top-level pane, put all its items directly
713 under the top-level menu. */
714 if (menu_items_n_panes == 1)
715 pane_string = "";
717 /* If the pane has a meaningful name,
718 make the pane a top-level menu item
719 with its items as a submenu beneath it. */
720 if (strcmp (pane_string, ""))
722 wv = xmalloc_widget_value ();
723 if (save_wv)
724 save_wv->next = wv;
725 else
726 first_wv->contents = wv;
727 wv->lname = pane_name;
728 /* Set value to 1 so update_submenu_strings can handle '@' */
729 wv->value = (char *)1;
730 wv->enabled = 1;
731 wv->button_type = BUTTON_TYPE_NONE;
732 wv->help = Qnil;
733 save_wv = wv;
735 else
736 save_wv = first_wv;
738 prev_wv = 0;
739 i += MENU_ITEMS_PANE_LENGTH;
741 else
743 /* Create a new item within current pane. */
744 Lisp_Object item_name, enable, descrip, def, type, selected;
745 Lisp_Object help;
747 /* All items should be contained in panes. */
748 if (! panes_seen)
749 emacs_abort ();
751 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
752 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
753 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
754 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
755 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
756 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
757 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
759 /* TTY menu items and their descriptions will be encoded by
760 tty_write_glyphs. */
761 if (!FRAME_TERMCAP_P (f))
763 #ifdef HAVE_NTGUI
764 if (STRINGP (item_name))
766 if (unicode_append_menu)
767 item_name = ENCODE_UTF_8 (item_name);
768 else if (STRING_MULTIBYTE (item_name))
769 item_name = ENCODE_SYSTEM (item_name);
771 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
774 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
776 descrip = ENCODE_SYSTEM (descrip);
777 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
779 #elif USE_LUCID
780 if (STRINGP (item_name))
782 item_name = ENCODE_UTF_8 (item_name);
783 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
786 if (STRINGP (descrip))
788 descrip = ENCODE_UTF_8 (descrip);
789 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
791 #elif !defined (HAVE_MULTILINGUAL_MENU)
792 if (STRING_MULTIBYTE (item_name))
794 item_name = ENCODE_MENU_STRING (item_name);
795 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
798 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
800 descrip = ENCODE_MENU_STRING (descrip);
801 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
803 #endif
806 wv = xmalloc_widget_value ();
807 if (prev_wv)
808 prev_wv->next = wv;
809 else
810 save_wv->contents = wv;
812 wv->lname = item_name;
813 if (!NILP (descrip))
814 wv->lkey = descrip;
815 wv->value = 0;
816 /* The intptr_t cast avoids a warning. There's no problem
817 as long as pointers have enough bits to hold small integers. */
818 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
819 wv->enabled = !NILP (enable);
821 if (NILP (type))
822 wv->button_type = BUTTON_TYPE_NONE;
823 else if (EQ (type, QCradio))
824 wv->button_type = BUTTON_TYPE_RADIO;
825 else if (EQ (type, QCtoggle))
826 wv->button_type = BUTTON_TYPE_TOGGLE;
827 else
828 emacs_abort ();
830 wv->selected = !NILP (selected);
831 if (! STRINGP (help))
832 help = Qnil;
834 wv->help = help;
836 prev_wv = wv;
838 i += MENU_ITEMS_ITEM_LENGTH;
842 /* If we have just one "menu item"
843 that was originally a button, return it by itself. */
844 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
846 wv = first_wv->contents;
847 free_widget_value (first_wv);
848 return wv;
851 return first_wv;
854 /* Walk through the widget_value tree starting at FIRST_WV and update
855 the char * pointers from the corresponding lisp values.
856 We do this after building the whole tree, since GC may happen while the
857 tree is constructed, and small strings are relocated. So we must wait
858 until no GC can happen before storing pointers into lisp values. */
859 void
860 update_submenu_strings (widget_value *first_wv)
862 widget_value *wv;
864 for (wv = first_wv; wv; wv = wv->next)
866 if (STRINGP (wv->lname))
868 wv->name = SSDATA (wv->lname);
870 /* Ignore the @ that means "separate pane".
871 This is a kludge, but this isn't worth more time. */
872 if (wv->value == (char *)1)
874 if (wv->name[0] == '@')
875 wv->name++;
876 wv->value = 0;
880 if (STRINGP (wv->lkey))
881 wv->key = SSDATA (wv->lkey);
883 if (wv->contents)
884 update_submenu_strings (wv->contents);
888 /* Find the menu selection and store it in the keyboard buffer.
889 F is the frame the menu is on.
890 MENU_BAR_ITEMS_USED is the length of VECTOR.
891 VECTOR is an array of menu events for the whole menu. */
893 void
894 find_and_call_menu_selection (struct frame *f, int menu_bar_items_used,
895 Lisp_Object vector, void *client_data)
897 Lisp_Object prefix, entry;
898 Lisp_Object *subprefix_stack;
899 int submenu_depth = 0;
900 int i;
902 entry = Qnil;
903 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
904 prefix = Qnil;
905 i = 0;
907 while (i < menu_bar_items_used)
909 if (EQ (AREF (vector, i), Qnil))
911 subprefix_stack[submenu_depth++] = prefix;
912 prefix = entry;
913 i++;
915 else if (EQ (AREF (vector, i), Qlambda))
917 prefix = subprefix_stack[--submenu_depth];
918 i++;
920 else if (EQ (AREF (vector, i), Qt))
922 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
923 i += MENU_ITEMS_PANE_LENGTH;
925 else
927 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
928 /* Treat the pointer as an integer. There's no problem
929 as long as pointers have enough bits to hold small integers. */
930 if ((intptr_t) client_data == i)
932 int j;
933 struct input_event buf;
934 Lisp_Object frame;
935 EVENT_INIT (buf);
937 XSETFRAME (frame, f);
938 buf.kind = MENU_BAR_EVENT;
939 buf.frame_or_window = frame;
940 buf.arg = frame;
941 kbd_buffer_store_event (&buf);
943 for (j = 0; j < submenu_depth; j++)
944 if (!NILP (subprefix_stack[j]))
946 buf.kind = MENU_BAR_EVENT;
947 buf.frame_or_window = frame;
948 buf.arg = subprefix_stack[j];
949 kbd_buffer_store_event (&buf);
952 if (!NILP (prefix))
954 buf.kind = MENU_BAR_EVENT;
955 buf.frame_or_window = frame;
956 buf.arg = prefix;
957 kbd_buffer_store_event (&buf);
960 buf.kind = MENU_BAR_EVENT;
961 buf.frame_or_window = frame;
962 buf.arg = entry;
963 kbd_buffer_store_event (&buf);
965 return;
967 i += MENU_ITEMS_ITEM_LENGTH;
972 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
974 #ifdef HAVE_NS
975 /* As above, but return the menu selection instead of storing in kb buffer.
976 If KEYMAPS, return full prefixes to selection. */
977 Lisp_Object
978 find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data)
980 Lisp_Object prefix, entry;
981 int i;
982 Lisp_Object *subprefix_stack;
983 int submenu_depth = 0;
985 prefix = entry = Qnil;
986 i = 0;
987 subprefix_stack = alloca (menu_items_used * word_size);
989 while (i < menu_items_used)
991 if (EQ (AREF (menu_items, i), Qnil))
993 subprefix_stack[submenu_depth++] = prefix;
994 prefix = entry;
995 i++;
997 else if (EQ (AREF (menu_items, i), Qlambda))
999 prefix = subprefix_stack[--submenu_depth];
1000 i++;
1002 else if (EQ (AREF (menu_items, i), Qt))
1004 prefix
1005 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1006 i += MENU_ITEMS_PANE_LENGTH;
1008 /* Ignore a nil in the item list.
1009 It's meaningful only for dialog boxes. */
1010 else if (EQ (AREF (menu_items, i), Qquote))
1011 i += 1;
1012 else
1014 entry
1015 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1016 if (aref_addr (menu_items, i) == client_data)
1018 if (keymaps)
1020 int j;
1022 entry = list1 (entry);
1023 if (!NILP (prefix))
1024 entry = Fcons (prefix, entry);
1025 for (j = submenu_depth - 1; j >= 0; j--)
1026 if (!NILP (subprefix_stack[j]))
1027 entry = Fcons (subprefix_stack[j], entry);
1029 return entry;
1031 i += MENU_ITEMS_ITEM_LENGTH;
1034 return Qnil;
1036 #endif /* HAVE_NS */
1038 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1039 doc: /* Pop up a deck-of-cards menu and return user's selection.
1040 POSITION is a position specification. This is either a mouse button event
1041 or a list ((XOFFSET YOFFSET) WINDOW)
1042 where XOFFSET and YOFFSET are positions in pixels from the top left
1043 corner of WINDOW. (WINDOW may be a window or a frame object.)
1044 This controls the position of the top left of the menu as a whole.
1045 If POSITION is t, it means to use the current mouse position.
1047 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1048 The menu items come from key bindings that have a menu string as well as
1049 a definition; actually, the "definition" in such a key binding looks like
1050 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1051 the keymap as a top-level element.
1053 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1054 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1056 You can also use a list of keymaps as MENU.
1057 Then each keymap makes a separate pane.
1059 When MENU is a keymap or a list of keymaps, the return value is the
1060 list of events corresponding to the user's choice. Note that
1061 `x-popup-menu' does not actually execute the command bound to that
1062 sequence of events.
1064 Alternatively, you can specify a menu of multiple panes
1065 with a list of the form (TITLE PANE1 PANE2...),
1066 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1067 Each ITEM is normally a cons cell (STRING . VALUE);
1068 but a string can appear as an item--that makes a nonselectable line
1069 in the menu.
1070 With this form of menu, the return value is VALUE from the chosen item.
1072 If POSITION is nil, don't display the menu at all, just precalculate the
1073 cached information about equivalent key sequences.
1075 If the user gets rid of the menu without making a valid choice, for
1076 instance by clicking the mouse away from a valid choice or by typing
1077 keyboard input, then this normally results in a quit and
1078 `x-popup-menu' does not return. But if POSITION is a mouse button
1079 event (indicating that the user invoked the menu with the mouse) then
1080 no quit occurs and `x-popup-menu' returns nil. */)
1081 (Lisp_Object position, Lisp_Object menu)
1083 Lisp_Object keymap, tem;
1084 int xpos = 0, ypos = 0;
1085 Lisp_Object title;
1086 const char *error_name = NULL;
1087 Lisp_Object selection = Qnil;
1088 struct frame *f = NULL;
1089 Lisp_Object x, y, window;
1090 bool keymaps = 0;
1091 bool for_click = 0;
1092 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1093 struct gcpro gcpro1;
1095 if (NILP (position))
1096 /* This is an obsolete call, which wants us to precompute the
1097 keybinding equivalents, but we don't do that any more anyway. */
1098 return Qnil;
1100 #ifdef HAVE_MENUS
1102 bool get_current_pos_p = 0;
1104 /* Decode the first argument: find the window and the coordinates. */
1105 if (EQ (position, Qt)
1106 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1107 || EQ (XCAR (position), Qtool_bar))))
1109 get_current_pos_p = 1;
1111 else
1113 tem = Fcar (position);
1114 if (CONSP (tem))
1116 window = Fcar (Fcdr (position));
1117 x = XCAR (tem);
1118 y = Fcar (XCDR (tem));
1120 else
1122 for_click = 1;
1123 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1124 window = Fcar (tem); /* POSN_WINDOW (tem) */
1125 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1126 x = Fcar (tem);
1127 y = Fcdr (tem);
1130 /* If a click happens in an external tool bar or a detached
1131 tool bar, x and y is NIL. In that case, use the current
1132 mouse position. This happens for the help button in the
1133 tool bar. Ideally popup-menu should pass NIL to
1134 this function, but it doesn't. */
1135 if (NILP (x) && NILP (y))
1136 get_current_pos_p = 1;
1139 if (get_current_pos_p)
1141 /* Use the mouse's current position. */
1142 struct frame *new_f = SELECTED_FRAME ();
1143 #ifdef HAVE_X_WINDOWS
1144 /* Can't use mouse_position_hook for X since it returns
1145 coordinates relative to the window the mouse is in,
1146 we need coordinates relative to the edit widget always. */
1147 if (new_f != 0)
1149 int cur_x, cur_y;
1151 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1152 /* cur_x/y may be negative, so use make_number. */
1153 x = make_number (cur_x);
1154 y = make_number (cur_y);
1157 #else /* not HAVE_X_WINDOWS */
1158 Lisp_Object bar_window;
1159 enum scroll_bar_part part;
1160 Time time;
1161 void (*mouse_position_hook) (struct frame **, int,
1162 Lisp_Object *,
1163 enum scroll_bar_part *,
1164 Lisp_Object *,
1165 Lisp_Object *,
1166 Time *) =
1167 FRAME_TERMINAL (new_f)->mouse_position_hook;
1169 if (mouse_position_hook)
1170 (*mouse_position_hook) (&new_f, 1, &bar_window,
1171 &part, &x, &y, &time);
1172 #endif /* not HAVE_X_WINDOWS */
1174 if (new_f != 0)
1175 XSETFRAME (window, new_f);
1176 else
1178 window = selected_window;
1179 XSETFASTINT (x, 0);
1180 XSETFASTINT (y, 0);
1184 /* Decode where to put the menu. */
1186 if (FRAMEP (window))
1188 f = XFRAME (window);
1189 xpos = 0;
1190 ypos = 0;
1192 else if (WINDOWP (window))
1194 struct window *win = XWINDOW (window);
1195 CHECK_LIVE_WINDOW (window);
1196 f = XFRAME (WINDOW_FRAME (win));
1198 xpos = WINDOW_LEFT_EDGE_X (win);
1199 ypos = WINDOW_TOP_EDGE_Y (win);
1201 else
1202 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1203 but I don't want to make one now. */
1204 CHECK_WINDOW (window);
1206 CHECK_RANGED_INTEGER (x,
1207 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1208 ? (EMACS_INT) INT_MIN - xpos
1209 : MOST_NEGATIVE_FIXNUM),
1210 INT_MAX - xpos);
1211 CHECK_RANGED_INTEGER (y,
1212 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1213 ? (EMACS_INT) INT_MIN - ypos
1214 : MOST_NEGATIVE_FIXNUM),
1215 INT_MAX - ypos);
1216 xpos += XINT (x);
1217 ypos += XINT (y);
1219 XSETFRAME (Vmenu_updating_frame, f);
1221 #endif /* HAVE_MENUS */
1223 /* Now parse the lisp menus. */
1224 record_unwind_protect_void (unuse_menu_items);
1226 title = Qnil;
1227 GCPRO1 (title);
1229 /* Decode the menu items from what was specified. */
1231 keymap = get_keymap (menu, 0, 0);
1232 if (CONSP (keymap))
1234 /* We were given a keymap. Extract menu info from the keymap. */
1235 Lisp_Object prompt;
1237 /* Extract the detailed info to make one pane. */
1238 keymap_panes (&menu, 1);
1240 /* Search for a string appearing directly as an element of the keymap.
1241 That string is the title of the menu. */
1242 prompt = Fkeymap_prompt (keymap);
1243 if (!NILP (prompt))
1244 title = prompt;
1245 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1246 else
1247 title = build_string ("Select");
1248 #endif
1250 /* Make that be the pane title of the first pane. */
1251 if (!NILP (prompt) && menu_items_n_panes >= 0)
1252 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1254 keymaps = 1;
1256 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1258 /* We were given a list of keymaps. */
1259 EMACS_INT nmaps = XFASTINT (Flength (menu));
1260 Lisp_Object *maps;
1261 ptrdiff_t i;
1262 USE_SAFE_ALLOCA;
1264 SAFE_ALLOCA_LISP (maps, nmaps);
1265 title = Qnil;
1267 /* The first keymap that has a prompt string
1268 supplies the menu title. */
1269 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1271 Lisp_Object prompt;
1273 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1275 prompt = Fkeymap_prompt (keymap);
1276 if (NILP (title) && !NILP (prompt))
1277 title = prompt;
1280 /* Extract the detailed info to make one pane. */
1281 keymap_panes (maps, nmaps);
1283 /* Make the title be the pane title of the first pane. */
1284 if (!NILP (title) && menu_items_n_panes >= 0)
1285 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1287 keymaps = 1;
1289 SAFE_FREE ();
1291 else
1293 /* We were given an old-fashioned menu. */
1294 title = Fcar (menu);
1295 CHECK_STRING (title);
1297 list_of_panes (Fcdr (menu));
1299 keymaps = 0;
1302 unbind_to (specpdl_count, Qnil);
1304 #ifdef HAVE_MENUS
1305 #ifdef HAVE_WINDOW_SYSTEM
1306 /* Hide a previous tip, if any. */
1307 if (!FRAME_TERMCAP_P (f))
1308 Fx_hide_tip ();
1309 #endif
1311 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1312 /* If resources from a previous popup menu still exist, does nothing
1313 until the `menu_free_timer' has freed them (see w32fns.c). This
1314 can occur if you press ESC or click outside a menu without selecting
1315 a menu item.
1317 if (current_popup_menu && FRAME_W32_P (f))
1319 discard_menu_items ();
1320 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1321 UNGCPRO;
1322 return Qnil;
1324 #endif
1326 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1327 record_unwind_protect_void (discard_menu_items);
1328 #endif
1330 /* Display them in a menu. */
1332 /* FIXME: Use a terminal hook! */
1333 #if defined HAVE_NTGUI
1334 if (FRAME_W32_P (f))
1335 selection = w32_menu_show (f, xpos, ypos, for_click,
1336 keymaps, title, &error_name);
1337 else
1338 #endif
1339 #if defined HAVE_NS
1340 if (FRAME_NS_P (f))
1341 selection = ns_menu_show (f, xpos, ypos, for_click,
1342 keymaps, title, &error_name);
1343 else
1344 #endif
1345 #if (defined (HAVE_X_WINDOWS) || defined (MSDOS))
1346 /* Assume last_event_timestamp is the timestamp of the button event.
1347 Is this assumption ever violated? We can't use the timestamp
1348 stored within POSITION because there the top bits from the actual
1349 timestamp may be truncated away (Bug#4930). */
1350 if (FRAME_X_P (f) || FRAME_MSDOS_P (f))
1351 selection = xmenu_show (f, xpos, ypos, for_click,
1352 keymaps, title, &error_name,
1353 last_event_timestamp);
1354 else
1355 #endif
1356 if (FRAME_TERMCAP_P (f))
1357 selection = tty_menu_show (f, xpos, ypos, for_click,
1358 keymaps, title, &error_name);
1360 #ifdef HAVE_NS
1361 unbind_to (specpdl_count, Qnil);
1362 #else
1363 discard_menu_items ();
1364 #endif
1366 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1367 if (FRAME_W32_P (f))
1368 FRAME_DISPLAY_INFO (f)->grabbed = 0;
1369 #endif
1371 #endif /* HAVE_MENUS */
1373 UNGCPRO;
1375 if (error_name) error ("%s", error_name);
1376 return selection;
1379 void
1380 syms_of_menu (void)
1382 staticpro (&menu_items);
1383 menu_items = Qnil;
1384 menu_items_inuse = Qnil;
1386 defsubr (&Sx_popup_menu);