* minibuf.texi (Basic Completion): Clarify list form of completion table.
[emacs.git] / src / menu.c
blob5374aa9157a90bbe68979d68a55b0c0693954b47
1 /* Platform-independent code for terminal communications.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2012
4 Free Software 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 extern AppendMenuW_Proc unicode_append_menu;
44 extern HMENU current_popup_menu;
45 #endif /* HAVE_NTGUI */
47 #include "menu.h"
49 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
50 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
51 #define HAVE_BOXES 1
52 #endif
54 Lisp_Object menu_items;
56 /* If non-nil, means that the global vars defined here are already in use.
57 Used to detect cases where we try to re-enter this non-reentrant code. */
58 #if ! (defined USE_GTK || defined USE_MOTIF)
59 static
60 #endif
61 Lisp_Object menu_items_inuse;
63 /* Number of slots currently allocated in menu_items. */
64 int menu_items_allocated;
66 /* This is the index in menu_items of the first empty slot. */
67 int menu_items_used;
69 /* The number of panes currently recorded in menu_items,
70 excluding those within submenus. */
71 int menu_items_n_panes;
73 /* Current depth within submenus. */
74 static int menu_items_submenu_depth;
76 void
77 init_menu_items (void)
79 if (!NILP (menu_items_inuse))
80 error ("Trying to use a menu from within a menu-entry");
82 if (NILP (menu_items))
84 menu_items_allocated = 60;
85 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
88 menu_items_inuse = Qt;
89 menu_items_used = 0;
90 menu_items_n_panes = 0;
91 menu_items_submenu_depth = 0;
94 /* Call at the end of generating the data in menu_items. */
96 void
97 finish_menu_items (void)
101 Lisp_Object
102 unuse_menu_items (Lisp_Object dummy)
104 return menu_items_inuse = Qnil;
107 /* Call when finished using the data for the current menu
108 in menu_items. */
110 void
111 discard_menu_items (void)
113 /* Free the structure if it is especially large.
114 Otherwise, hold on to it, to save time. */
115 if (menu_items_allocated > 200)
117 menu_items = Qnil;
118 menu_items_allocated = 0;
120 eassert (NILP (menu_items_inuse));
123 #ifdef HAVE_NS
124 static Lisp_Object
125 cleanup_popup_menu (Lisp_Object arg)
127 discard_menu_items ();
128 return Qnil;
130 #endif
132 /* This undoes save_menu_items, and it is called by the specpdl unwind
133 mechanism. */
135 static Lisp_Object
136 restore_menu_items (Lisp_Object saved)
138 menu_items = XCAR (saved);
139 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
140 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
141 saved = XCDR (saved);
142 menu_items_used = XINT (XCAR (saved));
143 saved = XCDR (saved);
144 menu_items_n_panes = XINT (XCAR (saved));
145 saved = XCDR (saved);
146 menu_items_submenu_depth = XINT (XCAR (saved));
147 return Qnil;
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 (0 < incr)
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 #ifndef HAVE_BOXES
293 /* Remember index for first item in this pane so we can go back and
294 add a prefix when (if) we see the first button. After that, notbuttons
295 is set to 0, to mark that we have seen a button and all non button
296 items need a prefix. */
297 skp.notbuttons = menu_items_used;
298 #endif
300 GCPRO1 (skp.pending_maps);
301 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
302 UNGCPRO;
304 /* Process now any submenus which want to be panes at this level. */
305 while (CONSP (skp.pending_maps))
307 Lisp_Object elt, eltcdr, string;
308 elt = XCAR (skp.pending_maps);
309 eltcdr = XCDR (elt);
310 string = XCAR (eltcdr);
311 /* We no longer discard the @ from the beginning of the string here.
312 Instead, we do this in *menu_show. */
313 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
314 skp.pending_maps = XCDR (skp.pending_maps);
318 /* This is a subroutine of single_keymap_panes that handles one
319 keymap entry.
320 KEY is a key in a keymap and ITEM is its binding.
321 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
322 separate panes.
323 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
325 static void
326 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
328 Lisp_Object map, item_string, enabled;
329 struct gcpro gcpro1, gcpro2;
330 int res;
331 struct skp *skp = skp_v;
333 /* Parse the menu item and leave the result in item_properties. */
334 GCPRO2 (key, item);
335 res = parse_menu_item (item, 0);
336 UNGCPRO;
337 if (!res)
338 return; /* Not a menu item. */
340 map = AREF (item_properties, ITEM_PROPERTY_MAP);
342 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
343 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
345 if (!NILP (map) && SREF (item_string, 0) == '@')
347 if (!NILP (enabled))
348 /* An enabled separate pane. Remember this to handle it later. */
349 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
350 skp->pending_maps);
351 return;
354 #if defined (HAVE_X_WINDOWS) || defined (MSDOS)
355 #ifndef HAVE_BOXES
356 /* Simulate radio buttons and toggle boxes by putting a prefix in
357 front of them. */
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);
416 #endif /* not HAVE_BOXES */
418 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
419 if (!NILP (map))
420 /* Indicate visually that this is a submenu. */
421 item_string = concat2 (item_string, build_string (" >"));
422 #endif
424 #endif /* HAVE_X_WINDOWS || MSDOS */
426 push_menu_item (item_string, enabled, key,
427 AREF (item_properties, ITEM_PROPERTY_DEF),
428 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
429 AREF (item_properties, ITEM_PROPERTY_TYPE),
430 AREF (item_properties, ITEM_PROPERTY_SELECTED),
431 AREF (item_properties, ITEM_PROPERTY_HELP));
433 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
434 /* Display a submenu using the toolkit. */
435 if (! (NILP (map) || NILP (enabled)))
437 push_submenu_start ();
438 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
439 push_submenu_end ();
441 #endif
444 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
445 and generate menu panes for them in menu_items. */
447 static void
448 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
450 ptrdiff_t mapno;
452 init_menu_items ();
454 /* Loop over the given keymaps, making a pane for each map.
455 But don't make a pane that is empty--ignore that map instead.
456 P is the number of panes we have made so far. */
457 for (mapno = 0; mapno < nmaps; mapno++)
458 single_keymap_panes (keymaps[mapno],
459 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
461 finish_menu_items ();
465 /* Push the items in a single pane defined by the alist PANE. */
466 static void
467 list_of_items (Lisp_Object pane)
469 Lisp_Object tail, item, item1;
471 for (tail = pane; CONSP (tail); tail = XCDR (tail))
473 item = XCAR (tail);
474 if (STRINGP (item))
475 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
476 Qnil, Qnil, Qnil, Qnil);
477 else if (CONSP (item))
479 item1 = XCAR (item);
480 CHECK_STRING (item1);
481 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
482 Qt, Qnil, Qnil, Qnil, Qnil);
484 else
485 push_left_right_boundary ();
490 /* Push all the panes and items of a menu described by the
491 alist-of-alists MENU.
492 This handles old-fashioned calls to x-popup-menu. */
493 void
494 list_of_panes (Lisp_Object menu)
496 Lisp_Object tail;
498 init_menu_items ();
500 for (tail = menu; CONSP (tail); tail = XCDR (tail))
502 Lisp_Object elt, pane_name, pane_data;
503 elt = XCAR (tail);
504 pane_name = Fcar (elt);
505 CHECK_STRING (pane_name);
506 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
507 pane_data = Fcdr (elt);
508 CHECK_CONS (pane_data);
509 list_of_items (pane_data);
512 finish_menu_items ();
515 /* Set up data in menu_items for a menu bar item
516 whose event type is ITEM_KEY (with string ITEM_NAME)
517 and whose contents come from the list of keymaps MAPS. */
519 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
521 Lisp_Object length;
522 EMACS_INT len;
523 Lisp_Object *mapvec;
524 ptrdiff_t i;
525 int top_level_items = 0;
526 USE_SAFE_ALLOCA;
528 length = Flength (maps);
529 len = XINT (length);
531 /* Convert the list MAPS into a vector MAPVEC. */
532 SAFE_ALLOCA_LISP (mapvec, len);
533 for (i = 0; i < len; i++)
535 mapvec[i] = Fcar (maps);
536 maps = Fcdr (maps);
539 /* Loop over the given keymaps, making a pane for each map.
540 But don't make a pane that is empty--ignore that map instead. */
541 for (i = 0; i < len; i++)
543 if (!KEYMAPP (mapvec[i]))
545 /* Here we have a command at top level in the menu bar
546 as opposed to a submenu. */
547 top_level_items = 1;
548 push_menu_pane (Qnil, Qnil);
549 push_menu_item (item_name, Qt, item_key, mapvec[i],
550 Qnil, Qnil, Qnil, Qnil);
552 else
554 Lisp_Object prompt;
555 prompt = Fkeymap_prompt (mapvec[i]);
556 single_keymap_panes (mapvec[i],
557 !NILP (prompt) ? prompt : item_name,
558 item_key, 10);
562 SAFE_FREE ();
563 return top_level_items;
567 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
569 /* Allocate a widget_value, blocking input. */
571 widget_value *
572 xmalloc_widget_value (void)
574 widget_value *value;
576 block_input ();
577 value = malloc_widget_value ();
578 unblock_input ();
580 return value;
583 /* This recursively calls free_widget_value on the tree of widgets.
584 It must free all data that was malloc'ed for these widget_values.
585 In Emacs, many slots are pointers into the data of Lisp_Strings, and
586 must be left alone. */
588 void
589 free_menubar_widget_value_tree (widget_value *wv)
591 if (! wv) return;
593 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
595 if (wv->contents && (wv->contents != (widget_value*)1))
597 free_menubar_widget_value_tree (wv->contents);
598 wv->contents = (widget_value *) 0xDEADBEEF;
600 if (wv->next)
602 free_menubar_widget_value_tree (wv->next);
603 wv->next = (widget_value *) 0xDEADBEEF;
605 block_input ();
606 free_widget_value (wv);
607 unblock_input ();
610 /* Create a tree of widget_value objects
611 representing the panes and items
612 in menu_items starting at index START, up to index END. */
614 widget_value *
615 digest_single_submenu (int start, int end, int top_level_items)
617 widget_value *wv, *prev_wv, *save_wv, *first_wv;
618 int i;
619 int submenu_depth = 0;
620 widget_value **submenu_stack;
621 int panes_seen = 0;
623 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
624 wv = xmalloc_widget_value ();
625 wv->name = "menu";
626 wv->value = 0;
627 wv->enabled = 1;
628 wv->button_type = BUTTON_TYPE_NONE;
629 wv->help = Qnil;
630 first_wv = wv;
631 save_wv = 0;
632 prev_wv = 0;
634 /* Loop over all panes and items made by the preceding call
635 to parse_single_submenu and construct a tree of widget_value objects.
636 Ignore the panes and items used by previous calls to
637 digest_single_submenu, even though those are also in menu_items. */
638 i = start;
639 while (i < end)
641 if (EQ (AREF (menu_items, i), Qnil))
643 submenu_stack[submenu_depth++] = save_wv;
644 save_wv = prev_wv;
645 prev_wv = 0;
646 i++;
648 else if (EQ (AREF (menu_items, i), Qlambda))
650 prev_wv = save_wv;
651 save_wv = submenu_stack[--submenu_depth];
652 i++;
654 else if (EQ (AREF (menu_items, i), Qt)
655 && submenu_depth != 0)
656 i += MENU_ITEMS_PANE_LENGTH;
657 /* Ignore a nil in the item list.
658 It's meaningful only for dialog boxes. */
659 else if (EQ (AREF (menu_items, i), Qquote))
660 i += 1;
661 else if (EQ (AREF (menu_items, i), Qt))
663 /* Create a new pane. */
664 Lisp_Object pane_name;
665 const char *pane_string;
667 panes_seen++;
669 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
671 #ifdef HAVE_NTGUI
672 if (STRINGP (pane_name))
674 if (unicode_append_menu)
675 /* Encode as UTF-8 for now. */
676 pane_name = ENCODE_UTF_8 (pane_name);
677 else if (STRING_MULTIBYTE (pane_name))
678 pane_name = ENCODE_SYSTEM (pane_name);
680 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
682 #elif defined (USE_LUCID) && defined (HAVE_XFT)
683 if (STRINGP (pane_name))
685 pane_name = ENCODE_UTF_8 (pane_name);
686 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
688 #elif !defined (HAVE_MULTILINGUAL_MENU)
689 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
691 pane_name = ENCODE_MENU_STRING (pane_name);
692 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
694 #endif
696 pane_string = (NILP (pane_name)
697 ? "" : SSDATA (pane_name));
698 /* If there is just one top-level pane, put all its items directly
699 under the top-level menu. */
700 if (menu_items_n_panes == 1)
701 pane_string = "";
703 /* If the pane has a meaningful name,
704 make the pane a top-level menu item
705 with its items as a submenu beneath it. */
706 if (strcmp (pane_string, ""))
708 wv = xmalloc_widget_value ();
709 if (save_wv)
710 save_wv->next = wv;
711 else
712 first_wv->contents = wv;
713 wv->lname = pane_name;
714 /* Set value to 1 so update_submenu_strings can handle '@' */
715 wv->value = (char *)1;
716 wv->enabled = 1;
717 wv->button_type = BUTTON_TYPE_NONE;
718 wv->help = Qnil;
719 save_wv = wv;
721 else
722 save_wv = first_wv;
724 prev_wv = 0;
725 i += MENU_ITEMS_PANE_LENGTH;
727 else
729 /* Create a new item within current pane. */
730 Lisp_Object item_name, enable, descrip, def, type, selected;
731 Lisp_Object help;
733 /* All items should be contained in panes. */
734 if (panes_seen == 0)
735 emacs_abort ();
737 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
738 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
739 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
740 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
741 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
742 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
743 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
745 #ifdef HAVE_NTGUI
746 if (STRINGP (item_name))
748 if (unicode_append_menu)
749 item_name = ENCODE_UTF_8 (item_name);
750 else if (STRING_MULTIBYTE (item_name))
751 item_name = ENCODE_SYSTEM (item_name);
753 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
756 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
758 descrip = ENCODE_SYSTEM (descrip);
759 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
761 #elif USE_LUCID
762 if (STRINGP (item_name))
764 item_name = ENCODE_UTF_8 (item_name);
765 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
768 if (STRINGP (descrip))
770 descrip = ENCODE_UTF_8 (descrip);
771 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
773 #elif !defined (HAVE_MULTILINGUAL_MENU)
774 if (STRING_MULTIBYTE (item_name))
776 item_name = ENCODE_MENU_STRING (item_name);
777 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
780 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
782 descrip = ENCODE_MENU_STRING (descrip);
783 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
785 #endif
787 wv = xmalloc_widget_value ();
788 if (prev_wv)
789 prev_wv->next = wv;
790 else
791 save_wv->contents = wv;
793 wv->lname = item_name;
794 if (!NILP (descrip))
795 wv->lkey = descrip;
796 wv->value = 0;
797 /* The intptr_t cast avoids a warning. There's no problem
798 as long as pointers have enough bits to hold small integers. */
799 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
800 wv->enabled = !NILP (enable);
802 if (NILP (type))
803 wv->button_type = BUTTON_TYPE_NONE;
804 else if (EQ (type, QCradio))
805 wv->button_type = BUTTON_TYPE_RADIO;
806 else if (EQ (type, QCtoggle))
807 wv->button_type = BUTTON_TYPE_TOGGLE;
808 else
809 emacs_abort ();
811 wv->selected = !NILP (selected);
812 if (! STRINGP (help))
813 help = Qnil;
815 wv->help = help;
817 prev_wv = wv;
819 i += MENU_ITEMS_ITEM_LENGTH;
823 /* If we have just one "menu item"
824 that was originally a button, return it by itself. */
825 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
827 wv = first_wv->contents;
828 free_widget_value (first_wv);
829 return wv;
832 return first_wv;
835 /* Walk through the widget_value tree starting at FIRST_WV and update
836 the char * pointers from the corresponding lisp values.
837 We do this after building the whole tree, since GC may happen while the
838 tree is constructed, and small strings are relocated. So we must wait
839 until no GC can happen before storing pointers into lisp values. */
840 void
841 update_submenu_strings (widget_value *first_wv)
843 widget_value *wv;
845 for (wv = first_wv; wv; wv = wv->next)
847 if (STRINGP (wv->lname))
849 wv->name = SSDATA (wv->lname);
851 /* Ignore the @ that means "separate pane".
852 This is a kludge, but this isn't worth more time. */
853 if (wv->value == (char *)1)
855 if (wv->name[0] == '@')
856 wv->name++;
857 wv->value = 0;
861 if (STRINGP (wv->lkey))
862 wv->key = SSDATA (wv->lkey);
864 if (wv->contents)
865 update_submenu_strings (wv->contents);
869 /* Find the menu selection and store it in the keyboard buffer.
870 F is the frame the menu is on.
871 MENU_BAR_ITEMS_USED is the length of VECTOR.
872 VECTOR is an array of menu events for the whole menu. */
874 void
875 find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
877 Lisp_Object prefix, entry;
878 Lisp_Object *subprefix_stack;
879 int submenu_depth = 0;
880 int i;
882 entry = Qnil;
883 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
884 prefix = Qnil;
885 i = 0;
887 while (i < menu_bar_items_used)
889 if (EQ (AREF (vector, i), Qnil))
891 subprefix_stack[submenu_depth++] = prefix;
892 prefix = entry;
893 i++;
895 else if (EQ (AREF (vector, i), Qlambda))
897 prefix = subprefix_stack[--submenu_depth];
898 i++;
900 else if (EQ (AREF (vector, i), Qt))
902 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
903 i += MENU_ITEMS_PANE_LENGTH;
905 else
907 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
908 /* Treat the pointer as an integer. There's no problem
909 as long as pointers have enough bits to hold small integers. */
910 if ((intptr_t) client_data == i)
912 int j;
913 struct input_event buf;
914 Lisp_Object frame;
915 EVENT_INIT (buf);
917 XSETFRAME (frame, f);
918 buf.kind = MENU_BAR_EVENT;
919 buf.frame_or_window = frame;
920 buf.arg = frame;
921 kbd_buffer_store_event (&buf);
923 for (j = 0; j < submenu_depth; j++)
924 if (!NILP (subprefix_stack[j]))
926 buf.kind = MENU_BAR_EVENT;
927 buf.frame_or_window = frame;
928 buf.arg = subprefix_stack[j];
929 kbd_buffer_store_event (&buf);
932 if (!NILP (prefix))
934 buf.kind = MENU_BAR_EVENT;
935 buf.frame_or_window = frame;
936 buf.arg = prefix;
937 kbd_buffer_store_event (&buf);
940 buf.kind = MENU_BAR_EVENT;
941 buf.frame_or_window = frame;
942 buf.arg = entry;
943 kbd_buffer_store_event (&buf);
945 return;
947 i += MENU_ITEMS_ITEM_LENGTH;
952 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
954 #ifdef HAVE_NS
955 /* As above, but return the menu selection instead of storing in kb buffer.
956 If keymaps==1, return full prefixes to selection. */
957 Lisp_Object
958 find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
960 Lisp_Object prefix, entry;
961 int i;
962 Lisp_Object *subprefix_stack;
963 int submenu_depth = 0;
965 prefix = entry = Qnil;
966 i = 0;
967 subprefix_stack = alloca (menu_items_used * word_size);
969 while (i < menu_items_used)
971 if (EQ (AREF (menu_items, i), Qnil))
973 subprefix_stack[submenu_depth++] = prefix;
974 prefix = entry;
975 i++;
977 else if (EQ (AREF (menu_items, i), Qlambda))
979 prefix = subprefix_stack[--submenu_depth];
980 i++;
982 else if (EQ (AREF (menu_items, i), Qt))
984 prefix
985 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
986 i += MENU_ITEMS_PANE_LENGTH;
988 /* Ignore a nil in the item list.
989 It's meaningful only for dialog boxes. */
990 else if (EQ (AREF (menu_items, i), Qquote))
991 i += 1;
992 else
994 entry
995 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
996 if (aref_addr (menu_items, i) == client_data)
998 if (keymaps != 0)
1000 int j;
1002 entry = Fcons (entry, Qnil);
1003 if (!NILP (prefix))
1004 entry = Fcons (prefix, entry);
1005 for (j = submenu_depth - 1; j >= 0; j--)
1006 if (!NILP (subprefix_stack[j]))
1007 entry = Fcons (subprefix_stack[j], entry);
1009 return entry;
1011 i += MENU_ITEMS_ITEM_LENGTH;
1014 return Qnil;
1016 #endif /* HAVE_NS */
1018 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1019 doc: /* Pop up a deck-of-cards menu and return user's selection.
1020 POSITION is a position specification. This is either a mouse button event
1021 or a list ((XOFFSET YOFFSET) WINDOW)
1022 where XOFFSET and YOFFSET are positions in pixels from the top left
1023 corner of WINDOW. (WINDOW may be a window or a frame object.)
1024 This controls the position of the top left of the menu as a whole.
1025 If POSITION is t, it means to use the current mouse position.
1027 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1028 The menu items come from key bindings that have a menu string as well as
1029 a definition; actually, the "definition" in such a key binding looks like
1030 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1031 the keymap as a top-level element.
1033 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1034 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1036 You can also use a list of keymaps as MENU.
1037 Then each keymap makes a separate pane.
1039 When MENU is a keymap or a list of keymaps, the return value is the
1040 list of events corresponding to the user's choice. Note that
1041 `x-popup-menu' does not actually execute the command bound to that
1042 sequence of events.
1044 Alternatively, you can specify a menu of multiple panes
1045 with a list of the form (TITLE PANE1 PANE2...),
1046 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1047 Each ITEM is normally a cons cell (STRING . VALUE);
1048 but a string can appear as an item--that makes a nonselectable line
1049 in the menu.
1050 With this form of menu, the return value is VALUE from the chosen item.
1052 If POSITION is nil, don't display the menu at all, just precalculate the
1053 cached information about equivalent key sequences.
1055 If the user gets rid of the menu without making a valid choice, for
1056 instance by clicking the mouse away from a valid choice or by typing
1057 keyboard input, then this normally results in a quit and
1058 `x-popup-menu' does not return. But if POSITION is a mouse button
1059 event (indicating that the user invoked the menu with the mouse) then
1060 no quit occurs and `x-popup-menu' returns nil. */)
1061 (Lisp_Object position, Lisp_Object menu)
1063 Lisp_Object keymap, tem;
1064 int xpos = 0, ypos = 0;
1065 Lisp_Object title;
1066 const char *error_name = NULL;
1067 Lisp_Object selection = Qnil;
1068 FRAME_PTR f = NULL;
1069 Lisp_Object x, y, window;
1070 int keymaps = 0;
1071 int for_click = 0;
1072 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1073 struct gcpro gcpro1;
1075 if (NILP (position))
1076 /* This is an obsolete call, which wants us to precompute the
1077 keybinding equivalents, but we don't do that any more anyway. */
1078 return Qnil;
1080 #ifdef HAVE_MENUS
1082 int get_current_pos_p = 0;
1083 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1085 /* Decode the first argument: find the window and the coordinates. */
1086 if (EQ (position, Qt)
1087 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1088 || EQ (XCAR (position), Qtool_bar))))
1090 get_current_pos_p = 1;
1092 else
1094 tem = Fcar (position);
1095 if (CONSP (tem))
1097 window = Fcar (Fcdr (position));
1098 x = XCAR (tem);
1099 y = Fcar (XCDR (tem));
1101 else
1103 for_click = 1;
1104 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1105 window = Fcar (tem); /* POSN_WINDOW (tem) */
1106 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1107 x = Fcar (tem);
1108 y = Fcdr (tem);
1111 /* If a click happens in an external tool bar or a detached
1112 tool bar, x and y is NIL. In that case, use the current
1113 mouse position. This happens for the help button in the
1114 tool bar. Ideally popup-menu should pass NIL to
1115 this function, but it doesn't. */
1116 if (NILP (x) && NILP (y))
1117 get_current_pos_p = 1;
1120 if (get_current_pos_p)
1122 /* Use the mouse's current position. */
1123 FRAME_PTR new_f = SELECTED_FRAME ();
1124 #ifdef HAVE_X_WINDOWS
1125 /* Can't use mouse_position_hook for X since it returns
1126 coordinates relative to the window the mouse is in,
1127 we need coordinates relative to the edit widget always. */
1128 if (new_f != 0)
1130 int cur_x, cur_y;
1132 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1133 /* cur_x/y may be negative, so use make_number. */
1134 x = make_number (cur_x);
1135 y = make_number (cur_y);
1138 #else /* not HAVE_X_WINDOWS */
1139 Lisp_Object bar_window;
1140 enum scroll_bar_part part;
1141 Time time;
1142 void (*mouse_position_hook) (struct frame **, int,
1143 Lisp_Object *,
1144 enum scroll_bar_part *,
1145 Lisp_Object *,
1146 Lisp_Object *,
1147 Time *) =
1148 FRAME_TERMINAL (new_f)->mouse_position_hook;
1150 if (mouse_position_hook)
1151 (*mouse_position_hook) (&new_f, 1, &bar_window,
1152 &part, &x, &y, &time);
1153 #endif /* not HAVE_X_WINDOWS */
1155 if (new_f != 0)
1156 XSETFRAME (window, new_f);
1157 else
1159 window = selected_window;
1160 XSETFASTINT (x, 0);
1161 XSETFASTINT (y, 0);
1165 /* Decode where to put the menu. */
1167 if (FRAMEP (window))
1169 f = XFRAME (window);
1170 xpos = 0;
1171 ypos = 0;
1173 else if (WINDOWP (window))
1175 struct window *win = XWINDOW (window);
1176 CHECK_LIVE_WINDOW (window);
1177 f = XFRAME (WINDOW_FRAME (win));
1179 xpos = WINDOW_LEFT_EDGE_X (win);
1180 ypos = WINDOW_TOP_EDGE_Y (win);
1182 else
1183 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1184 but I don't want to make one now. */
1185 CHECK_WINDOW (window);
1187 CHECK_RANGED_INTEGER (x,
1188 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1189 ? (EMACS_INT) INT_MIN - xpos
1190 : MOST_NEGATIVE_FIXNUM),
1191 INT_MAX - xpos);
1192 CHECK_RANGED_INTEGER (y,
1193 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1194 ? (EMACS_INT) INT_MIN - ypos
1195 : MOST_NEGATIVE_FIXNUM),
1196 INT_MAX - ypos);
1197 xpos += XINT (x);
1198 ypos += XINT (y);
1200 /* FIXME: Find a more general check! */
1201 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1202 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1203 error ("Can not put GUI menu on this terminal");
1205 XSETFRAME (Vmenu_updating_frame, f);
1207 #endif /* HAVE_MENUS */
1209 /* Now parse the lisp menus. */
1210 record_unwind_protect (unuse_menu_items, Qnil);
1212 title = Qnil;
1213 GCPRO1 (title);
1215 /* Decode the menu items from what was specified. */
1217 keymap = get_keymap (menu, 0, 0);
1218 if (CONSP (keymap))
1220 /* We were given a keymap. Extract menu info from the keymap. */
1221 Lisp_Object prompt;
1223 /* Extract the detailed info to make one pane. */
1224 keymap_panes (&menu, 1);
1226 /* Search for a string appearing directly as an element of the keymap.
1227 That string is the title of the menu. */
1228 prompt = Fkeymap_prompt (keymap);
1229 if (!NILP (prompt))
1230 title = prompt;
1231 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1232 else
1233 title = build_string ("Select");
1234 #endif
1236 /* Make that be the pane title of the first pane. */
1237 if (!NILP (prompt) && menu_items_n_panes >= 0)
1238 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1240 keymaps = 1;
1242 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1244 /* We were given a list of keymaps. */
1245 EMACS_INT nmaps = XFASTINT (Flength (menu));
1246 Lisp_Object *maps;
1247 ptrdiff_t i;
1248 USE_SAFE_ALLOCA;
1250 SAFE_ALLOCA_LISP (maps, nmaps);
1251 title = Qnil;
1253 /* The first keymap that has a prompt string
1254 supplies the menu title. */
1255 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1257 Lisp_Object prompt;
1259 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1261 prompt = Fkeymap_prompt (keymap);
1262 if (NILP (title) && !NILP (prompt))
1263 title = prompt;
1266 /* Extract the detailed info to make one pane. */
1267 keymap_panes (maps, nmaps);
1269 /* Make the title be the pane title of the first pane. */
1270 if (!NILP (title) && menu_items_n_panes >= 0)
1271 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1273 keymaps = 1;
1275 SAFE_FREE ();
1277 else
1279 /* We were given an old-fashioned menu. */
1280 title = Fcar (menu);
1281 CHECK_STRING (title);
1283 list_of_panes (Fcdr (menu));
1285 keymaps = 0;
1288 unbind_to (specpdl_count, Qnil);
1290 #ifdef HAVE_MENUS
1291 #ifdef HAVE_WINDOW_SYSTEM
1292 /* Hide a previous tip, if any. */
1293 Fx_hide_tip ();
1294 #endif
1296 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1297 /* If resources from a previous popup menu still exist, does nothing
1298 until the `menu_free_timer' has freed them (see w32fns.c). This
1299 can occur if you press ESC or click outside a menu without selecting
1300 a menu item.
1302 if (current_popup_menu)
1304 discard_menu_items ();
1305 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1306 UNGCPRO;
1307 return Qnil;
1309 #endif
1311 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1312 record_unwind_protect (cleanup_popup_menu, Qnil);
1313 #endif
1315 /* Display them in a menu. */
1316 block_input ();
1318 /* FIXME: Use a terminal hook! */
1319 #if defined HAVE_NTGUI
1320 selection = w32_menu_show (f, xpos, ypos, for_click,
1321 keymaps, title, &error_name);
1322 #elif defined HAVE_NS
1323 selection = ns_menu_show (f, xpos, ypos, for_click,
1324 keymaps, title, &error_name);
1325 #else /* MSDOS and X11 */
1326 /* Assume last_event_timestamp is the timestamp of the button event.
1327 Is this assumption ever violated? We can't use the timestamp
1328 stored within POSITION because there the top bits from the actual
1329 timestamp may be truncated away (Bug#4930). */
1330 selection = xmenu_show (f, xpos, ypos, for_click,
1331 keymaps, title, &error_name,
1332 last_event_timestamp);
1333 #endif
1335 unblock_input ();
1337 #ifdef HAVE_NS
1338 unbind_to (specpdl_count, Qnil);
1339 #else
1340 discard_menu_items ();
1341 #endif
1343 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1344 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1345 #endif
1347 #endif /* HAVE_MENUS */
1349 UNGCPRO;
1351 if (error_name) error ("%s", error_name);
1352 return selection;
1355 void
1356 syms_of_menu (void)
1358 staticpro (&menu_items);
1359 menu_items = Qnil;
1360 menu_items_inuse = Qnil;
1362 defsubr (&Sx_popup_menu);