commands.texi small fix for bug#13393
[emacs.git] / src / menu.c
blobfdef54dd6578cfd1d68f5d3f0f53965def677820
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 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
54 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
55 #define HAVE_BOXES 1
56 #endif
58 Lisp_Object menu_items;
60 /* If non-nil, means that the global vars defined here are already in use.
61 Used to detect cases where we try to re-enter this non-reentrant code. */
62 #if ! (defined USE_GTK || defined USE_MOTIF)
63 static
64 #endif
65 Lisp_Object menu_items_inuse;
67 /* Number of slots currently allocated in menu_items. */
68 int menu_items_allocated;
70 /* This is the index in menu_items of the first empty slot. */
71 int menu_items_used;
73 /* The number of panes currently recorded in menu_items,
74 excluding those within submenus. */
75 int menu_items_n_panes;
77 /* Current depth within submenus. */
78 static int menu_items_submenu_depth;
80 void
81 init_menu_items (void)
83 if (!NILP (menu_items_inuse))
84 error ("Trying to use a menu from within a menu-entry");
86 if (NILP (menu_items))
88 menu_items_allocated = 60;
89 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
92 menu_items_inuse = Qt;
93 menu_items_used = 0;
94 menu_items_n_panes = 0;
95 menu_items_submenu_depth = 0;
98 /* Call at the end of generating the data in menu_items. */
100 void
101 finish_menu_items (void)
105 Lisp_Object
106 unuse_menu_items (Lisp_Object dummy)
108 return menu_items_inuse = Qnil;
111 /* Call when finished using the data for the current menu
112 in menu_items. */
114 void
115 discard_menu_items (void)
117 /* Free the structure if it is especially large.
118 Otherwise, hold on to it, to save time. */
119 if (menu_items_allocated > 200)
121 menu_items = Qnil;
122 menu_items_allocated = 0;
124 eassert (NILP (menu_items_inuse));
127 #ifdef HAVE_NS
128 static Lisp_Object
129 cleanup_popup_menu (Lisp_Object arg)
131 discard_menu_items ();
132 return Qnil;
134 #endif
136 /* This undoes save_menu_items, and it is called by the specpdl unwind
137 mechanism. */
139 static Lisp_Object
140 restore_menu_items (Lisp_Object saved)
142 menu_items = XCAR (saved);
143 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
144 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
145 saved = XCDR (saved);
146 menu_items_used = XINT (XCAR (saved));
147 saved = XCDR (saved);
148 menu_items_n_panes = XINT (XCAR (saved));
149 saved = XCDR (saved);
150 menu_items_submenu_depth = XINT (XCAR (saved));
151 return Qnil;
154 /* Push the whole state of menu_items processing onto the specpdl.
155 It will be restored when the specpdl is unwound. */
157 void
158 save_menu_items (void)
160 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
161 make_number (menu_items_used),
162 make_number (menu_items_n_panes),
163 make_number (menu_items_submenu_depth));
164 record_unwind_protect (restore_menu_items, saved);
165 menu_items_inuse = Qnil;
166 menu_items = Qnil;
170 /* Ensure that there is room for ITEMS items in the menu_items vector. */
172 static void
173 ensure_menu_items (int items)
175 int incr = items - (menu_items_allocated - menu_items_used);
176 if (0 < incr)
178 menu_items = larger_vector (menu_items, incr, INT_MAX);
179 menu_items_allocated = ASIZE (menu_items);
183 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
184 || defined HAVE_NTGUI)
186 /* Begin a submenu. */
188 static void
189 push_submenu_start (void)
191 ensure_menu_items (1);
192 ASET (menu_items, menu_items_used, Qnil);
193 menu_items_used++;
194 menu_items_submenu_depth++;
197 /* End a submenu. */
199 static void
200 push_submenu_end (void)
202 ensure_menu_items (1);
203 ASET (menu_items, menu_items_used, Qlambda);
204 menu_items_used++;
205 menu_items_submenu_depth--;
208 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
210 /* Indicate boundary between left and right. */
212 static void
213 push_left_right_boundary (void)
215 ensure_menu_items (1);
216 ASET (menu_items, menu_items_used, Qquote);
217 menu_items_used++;
220 /* Start a new menu pane in menu_items.
221 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
223 static void
224 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
226 ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
227 if (menu_items_submenu_depth == 0)
228 menu_items_n_panes++;
229 ASET (menu_items, menu_items_used, Qt);
230 menu_items_used++;
231 ASET (menu_items, menu_items_used, name);
232 menu_items_used++;
233 ASET (menu_items, menu_items_used, prefix_vec);
234 menu_items_used++;
237 /* Push one menu item into the current pane. NAME is the string to
238 display. ENABLE if non-nil means this item can be selected. KEY
239 is the key generated by choosing this item, or nil if this item
240 doesn't really have a definition. DEF is the definition of this
241 item. EQUIV is the textual description of the keyboard equivalent
242 for this item (or nil if none). TYPE is the type of this menu
243 item, one of nil, `toggle' or `radio'. */
245 static void
246 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)
248 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
250 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
252 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
253 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
254 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
255 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
256 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
257 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
259 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
262 /* Args passed between single_keymap_panes and single_menu_item. */
263 struct skp
265 Lisp_Object pending_maps;
266 int maxdepth;
267 int notbuttons;
270 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
271 void *);
273 /* This is a recursive subroutine of keymap_panes.
274 It handles one keymap, KEYMAP.
275 The other arguments are passed along
276 or point to local variables of the previous function.
278 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
280 static void
281 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
282 Lisp_Object prefix, int maxdepth)
284 struct skp skp;
285 struct gcpro gcpro1;
287 skp.pending_maps = Qnil;
288 skp.maxdepth = maxdepth;
289 skp.notbuttons = 0;
291 if (maxdepth <= 0)
292 return;
294 push_menu_pane (pane_name, prefix);
296 #ifndef HAVE_BOXES
297 /* Remember index for first item in this pane so we can go back and
298 add a prefix when (if) we see the first button. After that, notbuttons
299 is set to 0, to mark that we have seen a button and all non button
300 items need a prefix. */
301 skp.notbuttons = menu_items_used;
302 #endif
304 GCPRO1 (skp.pending_maps);
305 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
306 UNGCPRO;
308 /* Process now any submenus which want to be panes at this level. */
309 while (CONSP (skp.pending_maps))
311 Lisp_Object elt, eltcdr, string;
312 elt = XCAR (skp.pending_maps);
313 eltcdr = XCDR (elt);
314 string = XCAR (eltcdr);
315 /* We no longer discard the @ from the beginning of the string here.
316 Instead, we do this in *menu_show. */
317 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
318 skp.pending_maps = XCDR (skp.pending_maps);
322 /* This is a subroutine of single_keymap_panes that handles one
323 keymap entry.
324 KEY is a key in a keymap and ITEM is its binding.
325 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
326 separate panes.
327 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
329 static void
330 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
332 Lisp_Object map, item_string, enabled;
333 struct gcpro gcpro1, gcpro2;
334 bool res;
335 struct skp *skp = skp_v;
337 /* Parse the menu item and leave the result in item_properties. */
338 GCPRO2 (key, item);
339 res = parse_menu_item (item, 0);
340 UNGCPRO;
341 if (!res)
342 return; /* Not a menu item. */
344 map = AREF (item_properties, ITEM_PROPERTY_MAP);
346 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
347 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
349 if (!NILP (map) && SREF (item_string, 0) == '@')
351 if (!NILP (enabled))
352 /* An enabled separate pane. Remember this to handle it later. */
353 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
354 skp->pending_maps);
355 return;
358 #if defined (HAVE_X_WINDOWS) || defined (MSDOS)
359 #ifndef HAVE_BOXES
360 /* Simulate radio buttons and toggle boxes by putting a prefix in
361 front of them. */
363 Lisp_Object prefix = Qnil;
364 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
365 if (!NILP (type))
367 Lisp_Object selected
368 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
370 if (skp->notbuttons)
371 /* The first button. Line up previous items in this menu. */
373 int idx = skp->notbuttons; /* Index for first item this menu. */
374 int submenu = 0;
375 Lisp_Object tem;
376 while (idx < menu_items_used)
379 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
380 if (NILP (tem))
382 idx++;
383 submenu++; /* Skip sub menu. */
385 else if (EQ (tem, Qlambda))
387 idx++;
388 submenu--; /* End sub menu. */
390 else if (EQ (tem, Qt))
391 idx += 3; /* Skip new pane marker. */
392 else if (EQ (tem, Qquote))
393 idx++; /* Skip a left, right divider. */
394 else
396 if (!submenu && SREF (tem, 0) != '\0'
397 && SREF (tem, 0) != '-')
398 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
399 concat2 (build_string (" "), tem));
400 idx += MENU_ITEMS_ITEM_LENGTH;
403 skp->notbuttons = 0;
406 /* Calculate prefix, if any, for this item. */
407 if (EQ (type, QCtoggle))
408 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
409 else if (EQ (type, QCradio))
410 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
412 /* Not a button. If we have earlier buttons, then we need a prefix. */
413 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
414 && SREF (item_string, 0) != '-')
415 prefix = build_string (" ");
417 if (!NILP (prefix))
418 item_string = concat2 (prefix, item_string);
420 #endif /* not HAVE_BOXES */
422 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
423 if (!NILP (map))
424 /* Indicate visually that this is a submenu. */
425 item_string = concat2 (item_string, build_string (" >"));
426 #endif
428 #endif /* HAVE_X_WINDOWS || MSDOS */
430 push_menu_item (item_string, enabled, key,
431 AREF (item_properties, ITEM_PROPERTY_DEF),
432 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
433 AREF (item_properties, ITEM_PROPERTY_TYPE),
434 AREF (item_properties, ITEM_PROPERTY_SELECTED),
435 AREF (item_properties, ITEM_PROPERTY_HELP));
437 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
438 /* Display a submenu using the toolkit. */
439 if (! (NILP (map) || NILP (enabled)))
441 push_submenu_start ();
442 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
443 push_submenu_end ();
445 #endif
448 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
449 and generate menu panes for them in menu_items. */
451 static void
452 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
454 ptrdiff_t mapno;
456 init_menu_items ();
458 /* Loop over the given keymaps, making a pane for each map.
459 But don't make a pane that is empty--ignore that map instead.
460 P is the number of panes we have made so far. */
461 for (mapno = 0; mapno < nmaps; mapno++)
462 single_keymap_panes (keymaps[mapno],
463 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
465 finish_menu_items ();
469 /* Push the items in a single pane defined by the alist PANE. */
470 static void
471 list_of_items (Lisp_Object pane)
473 Lisp_Object tail, item, item1;
475 for (tail = pane; CONSP (tail); tail = XCDR (tail))
477 item = XCAR (tail);
478 if (STRINGP (item))
479 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
480 Qnil, Qnil, Qnil, Qnil);
481 else if (CONSP (item))
483 item1 = XCAR (item);
484 CHECK_STRING (item1);
485 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
486 Qt, Qnil, Qnil, Qnil, Qnil);
488 else
489 push_left_right_boundary ();
494 /* Push all the panes and items of a menu described by the
495 alist-of-alists MENU.
496 This handles old-fashioned calls to x-popup-menu. */
497 void
498 list_of_panes (Lisp_Object menu)
500 Lisp_Object tail;
502 init_menu_items ();
504 for (tail = menu; CONSP (tail); tail = XCDR (tail))
506 Lisp_Object elt, pane_name, pane_data;
507 elt = XCAR (tail);
508 pane_name = Fcar (elt);
509 CHECK_STRING (pane_name);
510 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
511 pane_data = Fcdr (elt);
512 CHECK_CONS (pane_data);
513 list_of_items (pane_data);
516 finish_menu_items ();
519 /* Set up data in menu_items for a menu bar item
520 whose event type is ITEM_KEY (with string ITEM_NAME)
521 and whose contents come from the list of keymaps MAPS. */
522 bool
523 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name,
524 Lisp_Object maps)
526 Lisp_Object length;
527 EMACS_INT len;
528 Lisp_Object *mapvec;
529 ptrdiff_t i;
530 bool top_level_items = 0;
531 USE_SAFE_ALLOCA;
533 length = Flength (maps);
534 len = XINT (length);
536 /* Convert the list MAPS into a vector MAPVEC. */
537 SAFE_ALLOCA_LISP (mapvec, len);
538 for (i = 0; i < len; i++)
540 mapvec[i] = Fcar (maps);
541 maps = Fcdr (maps);
544 /* Loop over the given keymaps, making a pane for each map.
545 But don't make a pane that is empty--ignore that map instead. */
546 for (i = 0; i < len; i++)
548 if (!KEYMAPP (mapvec[i]))
550 /* Here we have a command at top level in the menu bar
551 as opposed to a submenu. */
552 top_level_items = 1;
553 push_menu_pane (Qnil, Qnil);
554 push_menu_item (item_name, Qt, item_key, mapvec[i],
555 Qnil, Qnil, Qnil, Qnil);
557 else
559 Lisp_Object prompt;
560 prompt = Fkeymap_prompt (mapvec[i]);
561 single_keymap_panes (mapvec[i],
562 !NILP (prompt) ? prompt : item_name,
563 item_key, 10);
567 SAFE_FREE ();
568 return top_level_items;
572 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
574 /* Allocate a widget_value, blocking input. */
576 widget_value *
577 xmalloc_widget_value (void)
579 widget_value *value;
581 block_input ();
582 value = malloc_widget_value ();
583 unblock_input ();
585 return value;
588 /* This recursively calls free_widget_value on the tree of widgets.
589 It must free all data that was malloc'ed for these widget_values.
590 In Emacs, many slots are pointers into the data of Lisp_Strings, and
591 must be left alone. */
593 void
594 free_menubar_widget_value_tree (widget_value *wv)
596 if (! wv) return;
598 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
600 if (wv->contents && (wv->contents != (widget_value*)1))
602 free_menubar_widget_value_tree (wv->contents);
603 wv->contents = (widget_value *) 0xDEADBEEF;
605 if (wv->next)
607 free_menubar_widget_value_tree (wv->next);
608 wv->next = (widget_value *) 0xDEADBEEF;
610 block_input ();
611 free_widget_value (wv);
612 unblock_input ();
615 /* Create a tree of widget_value objects
616 representing the panes and items
617 in menu_items starting at index START, up to index END. */
619 widget_value *
620 digest_single_submenu (int start, int end, bool top_level_items)
622 widget_value *wv, *prev_wv, *save_wv, *first_wv;
623 int i;
624 int submenu_depth = 0;
625 widget_value **submenu_stack;
626 bool panes_seen = 0;
628 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
629 wv = xmalloc_widget_value ();
630 wv->name = "menu";
631 wv->value = 0;
632 wv->enabled = 1;
633 wv->button_type = BUTTON_TYPE_NONE;
634 wv->help = Qnil;
635 first_wv = wv;
636 save_wv = 0;
637 prev_wv = 0;
639 /* Loop over all panes and items made by the preceding call
640 to parse_single_submenu and construct a tree of widget_value objects.
641 Ignore the panes and items used by previous calls to
642 digest_single_submenu, even though those are also in menu_items. */
643 i = start;
644 while (i < end)
646 if (EQ (AREF (menu_items, i), Qnil))
648 submenu_stack[submenu_depth++] = save_wv;
649 save_wv = prev_wv;
650 prev_wv = 0;
651 i++;
653 else if (EQ (AREF (menu_items, i), Qlambda))
655 prev_wv = save_wv;
656 save_wv = submenu_stack[--submenu_depth];
657 i++;
659 else if (EQ (AREF (menu_items, i), Qt)
660 && submenu_depth != 0)
661 i += MENU_ITEMS_PANE_LENGTH;
662 /* Ignore a nil in the item list.
663 It's meaningful only for dialog boxes. */
664 else if (EQ (AREF (menu_items, i), Qquote))
665 i += 1;
666 else if (EQ (AREF (menu_items, i), Qt))
668 /* Create a new pane. */
669 Lisp_Object pane_name;
670 const char *pane_string;
672 panes_seen = 1;
674 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
676 #ifdef HAVE_NTGUI
677 if (STRINGP (pane_name))
679 if (unicode_append_menu)
680 /* Encode as UTF-8 for now. */
681 pane_name = ENCODE_UTF_8 (pane_name);
682 else if (STRING_MULTIBYTE (pane_name))
683 pane_name = ENCODE_SYSTEM (pane_name);
685 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
687 #elif defined (USE_LUCID) && defined (HAVE_XFT)
688 if (STRINGP (pane_name))
690 pane_name = ENCODE_UTF_8 (pane_name);
691 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
693 #elif !defined (HAVE_MULTILINGUAL_MENU)
694 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
696 pane_name = ENCODE_MENU_STRING (pane_name);
697 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
699 #endif
701 pane_string = (NILP (pane_name)
702 ? "" : SSDATA (pane_name));
703 /* If there is just one top-level pane, put all its items directly
704 under the top-level menu. */
705 if (menu_items_n_panes == 1)
706 pane_string = "";
708 /* If the pane has a meaningful name,
709 make the pane a top-level menu item
710 with its items as a submenu beneath it. */
711 if (strcmp (pane_string, ""))
713 wv = xmalloc_widget_value ();
714 if (save_wv)
715 save_wv->next = wv;
716 else
717 first_wv->contents = wv;
718 wv->lname = pane_name;
719 /* Set value to 1 so update_submenu_strings can handle '@' */
720 wv->value = (char *)1;
721 wv->enabled = 1;
722 wv->button_type = BUTTON_TYPE_NONE;
723 wv->help = Qnil;
724 save_wv = wv;
726 else
727 save_wv = first_wv;
729 prev_wv = 0;
730 i += MENU_ITEMS_PANE_LENGTH;
732 else
734 /* Create a new item within current pane. */
735 Lisp_Object item_name, enable, descrip, def, type, selected;
736 Lisp_Object help;
738 /* All items should be contained in panes. */
739 if (! panes_seen)
740 emacs_abort ();
742 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
743 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
744 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
745 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
746 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
747 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
748 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
750 #ifdef HAVE_NTGUI
751 if (STRINGP (item_name))
753 if (unicode_append_menu)
754 item_name = ENCODE_UTF_8 (item_name);
755 else if (STRING_MULTIBYTE (item_name))
756 item_name = ENCODE_SYSTEM (item_name);
758 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
761 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
763 descrip = ENCODE_SYSTEM (descrip);
764 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
766 #elif USE_LUCID
767 if (STRINGP (item_name))
769 item_name = ENCODE_UTF_8 (item_name);
770 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
773 if (STRINGP (descrip))
775 descrip = ENCODE_UTF_8 (descrip);
776 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
778 #elif !defined (HAVE_MULTILINGUAL_MENU)
779 if (STRING_MULTIBYTE (item_name))
781 item_name = ENCODE_MENU_STRING (item_name);
782 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
785 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
787 descrip = ENCODE_MENU_STRING (descrip);
788 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
790 #endif
792 wv = xmalloc_widget_value ();
793 if (prev_wv)
794 prev_wv->next = wv;
795 else
796 save_wv->contents = wv;
798 wv->lname = item_name;
799 if (!NILP (descrip))
800 wv->lkey = descrip;
801 wv->value = 0;
802 /* The intptr_t cast avoids a warning. There's no problem
803 as long as pointers have enough bits to hold small integers. */
804 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
805 wv->enabled = !NILP (enable);
807 if (NILP (type))
808 wv->button_type = BUTTON_TYPE_NONE;
809 else if (EQ (type, QCradio))
810 wv->button_type = BUTTON_TYPE_RADIO;
811 else if (EQ (type, QCtoggle))
812 wv->button_type = BUTTON_TYPE_TOGGLE;
813 else
814 emacs_abort ();
816 wv->selected = !NILP (selected);
817 if (! STRINGP (help))
818 help = Qnil;
820 wv->help = help;
822 prev_wv = wv;
824 i += MENU_ITEMS_ITEM_LENGTH;
828 /* If we have just one "menu item"
829 that was originally a button, return it by itself. */
830 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
832 wv = first_wv->contents;
833 free_widget_value (first_wv);
834 return wv;
837 return first_wv;
840 /* Walk through the widget_value tree starting at FIRST_WV and update
841 the char * pointers from the corresponding lisp values.
842 We do this after building the whole tree, since GC may happen while the
843 tree is constructed, and small strings are relocated. So we must wait
844 until no GC can happen before storing pointers into lisp values. */
845 void
846 update_submenu_strings (widget_value *first_wv)
848 widget_value *wv;
850 for (wv = first_wv; wv; wv = wv->next)
852 if (STRINGP (wv->lname))
854 wv->name = SSDATA (wv->lname);
856 /* Ignore the @ that means "separate pane".
857 This is a kludge, but this isn't worth more time. */
858 if (wv->value == (char *)1)
860 if (wv->name[0] == '@')
861 wv->name++;
862 wv->value = 0;
866 if (STRINGP (wv->lkey))
867 wv->key = SSDATA (wv->lkey);
869 if (wv->contents)
870 update_submenu_strings (wv->contents);
874 /* Find the menu selection and store it in the keyboard buffer.
875 F is the frame the menu is on.
876 MENU_BAR_ITEMS_USED is the length of VECTOR.
877 VECTOR is an array of menu events for the whole menu. */
879 void
880 find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
882 Lisp_Object prefix, entry;
883 Lisp_Object *subprefix_stack;
884 int submenu_depth = 0;
885 int i;
887 entry = Qnil;
888 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
889 prefix = Qnil;
890 i = 0;
892 while (i < menu_bar_items_used)
894 if (EQ (AREF (vector, i), Qnil))
896 subprefix_stack[submenu_depth++] = prefix;
897 prefix = entry;
898 i++;
900 else if (EQ (AREF (vector, i), Qlambda))
902 prefix = subprefix_stack[--submenu_depth];
903 i++;
905 else if (EQ (AREF (vector, i), Qt))
907 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
908 i += MENU_ITEMS_PANE_LENGTH;
910 else
912 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
913 /* Treat the pointer as an integer. There's no problem
914 as long as pointers have enough bits to hold small integers. */
915 if ((intptr_t) client_data == i)
917 int j;
918 struct input_event buf;
919 Lisp_Object frame;
920 EVENT_INIT (buf);
922 XSETFRAME (frame, f);
923 buf.kind = MENU_BAR_EVENT;
924 buf.frame_or_window = frame;
925 buf.arg = frame;
926 kbd_buffer_store_event (&buf);
928 for (j = 0; j < submenu_depth; j++)
929 if (!NILP (subprefix_stack[j]))
931 buf.kind = MENU_BAR_EVENT;
932 buf.frame_or_window = frame;
933 buf.arg = subprefix_stack[j];
934 kbd_buffer_store_event (&buf);
937 if (!NILP (prefix))
939 buf.kind = MENU_BAR_EVENT;
940 buf.frame_or_window = frame;
941 buf.arg = prefix;
942 kbd_buffer_store_event (&buf);
945 buf.kind = MENU_BAR_EVENT;
946 buf.frame_or_window = frame;
947 buf.arg = entry;
948 kbd_buffer_store_event (&buf);
950 return;
952 i += MENU_ITEMS_ITEM_LENGTH;
957 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
959 #ifdef HAVE_NS
960 /* As above, but return the menu selection instead of storing in kb buffer.
961 If KEYMAPS, return full prefixes to selection. */
962 Lisp_Object
963 find_and_return_menu_selection (FRAME_PTR f, bool keymaps, void *client_data)
965 Lisp_Object prefix, entry;
966 int i;
967 Lisp_Object *subprefix_stack;
968 int submenu_depth = 0;
970 prefix = entry = Qnil;
971 i = 0;
972 subprefix_stack = alloca (menu_items_used * word_size);
974 while (i < menu_items_used)
976 if (EQ (AREF (menu_items, i), Qnil))
978 subprefix_stack[submenu_depth++] = prefix;
979 prefix = entry;
980 i++;
982 else if (EQ (AREF (menu_items, i), Qlambda))
984 prefix = subprefix_stack[--submenu_depth];
985 i++;
987 else if (EQ (AREF (menu_items, i), Qt))
989 prefix
990 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
991 i += MENU_ITEMS_PANE_LENGTH;
993 /* Ignore a nil in the item list.
994 It's meaningful only for dialog boxes. */
995 else if (EQ (AREF (menu_items, i), Qquote))
996 i += 1;
997 else
999 entry
1000 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1001 if (aref_addr (menu_items, i) == client_data)
1003 if (keymaps)
1005 int j;
1007 entry = Fcons (entry, Qnil);
1008 if (!NILP (prefix))
1009 entry = Fcons (prefix, entry);
1010 for (j = submenu_depth - 1; j >= 0; j--)
1011 if (!NILP (subprefix_stack[j]))
1012 entry = Fcons (subprefix_stack[j], entry);
1014 return entry;
1016 i += MENU_ITEMS_ITEM_LENGTH;
1019 return Qnil;
1021 #endif /* HAVE_NS */
1023 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1024 doc: /* Pop up a deck-of-cards menu and return user's selection.
1025 POSITION is a position specification. This is either a mouse button event
1026 or a list ((XOFFSET YOFFSET) WINDOW)
1027 where XOFFSET and YOFFSET are positions in pixels from the top left
1028 corner of WINDOW. (WINDOW may be a window or a frame object.)
1029 This controls the position of the top left of the menu as a whole.
1030 If POSITION is t, it means to use the current mouse position.
1032 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1033 The menu items come from key bindings that have a menu string as well as
1034 a definition; actually, the "definition" in such a key binding looks like
1035 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1036 the keymap as a top-level element.
1038 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1039 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1041 You can also use a list of keymaps as MENU.
1042 Then each keymap makes a separate pane.
1044 When MENU is a keymap or a list of keymaps, the return value is the
1045 list of events corresponding to the user's choice. Note that
1046 `x-popup-menu' does not actually execute the command bound to that
1047 sequence of events.
1049 Alternatively, you can specify a menu of multiple panes
1050 with a list of the form (TITLE PANE1 PANE2...),
1051 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1052 Each ITEM is normally a cons cell (STRING . VALUE);
1053 but a string can appear as an item--that makes a nonselectable line
1054 in the menu.
1055 With this form of menu, the return value is VALUE from the chosen item.
1057 If POSITION is nil, don't display the menu at all, just precalculate the
1058 cached information about equivalent key sequences.
1060 If the user gets rid of the menu without making a valid choice, for
1061 instance by clicking the mouse away from a valid choice or by typing
1062 keyboard input, then this normally results in a quit and
1063 `x-popup-menu' does not return. But if POSITION is a mouse button
1064 event (indicating that the user invoked the menu with the mouse) then
1065 no quit occurs and `x-popup-menu' returns nil. */)
1066 (Lisp_Object position, Lisp_Object menu)
1068 Lisp_Object keymap, tem;
1069 int xpos = 0, ypos = 0;
1070 Lisp_Object title;
1071 const char *error_name = NULL;
1072 Lisp_Object selection = Qnil;
1073 FRAME_PTR f = NULL;
1074 Lisp_Object x, y, window;
1075 bool keymaps = 0;
1076 bool for_click = 0;
1077 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1078 struct gcpro gcpro1;
1080 if (NILP (position))
1081 /* This is an obsolete call, which wants us to precompute the
1082 keybinding equivalents, but we don't do that any more anyway. */
1083 return Qnil;
1085 #ifdef HAVE_MENUS
1087 bool get_current_pos_p = 0;
1088 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1090 /* Decode the first argument: find the window and the coordinates. */
1091 if (EQ (position, Qt)
1092 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1093 || EQ (XCAR (position), Qtool_bar))))
1095 get_current_pos_p = 1;
1097 else
1099 tem = Fcar (position);
1100 if (CONSP (tem))
1102 window = Fcar (Fcdr (position));
1103 x = XCAR (tem);
1104 y = Fcar (XCDR (tem));
1106 else
1108 for_click = 1;
1109 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1110 window = Fcar (tem); /* POSN_WINDOW (tem) */
1111 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1112 x = Fcar (tem);
1113 y = Fcdr (tem);
1116 /* If a click happens in an external tool bar or a detached
1117 tool bar, x and y is NIL. In that case, use the current
1118 mouse position. This happens for the help button in the
1119 tool bar. Ideally popup-menu should pass NIL to
1120 this function, but it doesn't. */
1121 if (NILP (x) && NILP (y))
1122 get_current_pos_p = 1;
1125 if (get_current_pos_p)
1127 /* Use the mouse's current position. */
1128 FRAME_PTR new_f = SELECTED_FRAME ();
1129 #ifdef HAVE_X_WINDOWS
1130 /* Can't use mouse_position_hook for X since it returns
1131 coordinates relative to the window the mouse is in,
1132 we need coordinates relative to the edit widget always. */
1133 if (new_f != 0)
1135 int cur_x, cur_y;
1137 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1138 /* cur_x/y may be negative, so use make_number. */
1139 x = make_number (cur_x);
1140 y = make_number (cur_y);
1143 #else /* not HAVE_X_WINDOWS */
1144 Lisp_Object bar_window;
1145 enum scroll_bar_part part;
1146 Time time;
1147 void (*mouse_position_hook) (struct frame **, int,
1148 Lisp_Object *,
1149 enum scroll_bar_part *,
1150 Lisp_Object *,
1151 Lisp_Object *,
1152 Time *) =
1153 FRAME_TERMINAL (new_f)->mouse_position_hook;
1155 if (mouse_position_hook)
1156 (*mouse_position_hook) (&new_f, 1, &bar_window,
1157 &part, &x, &y, &time);
1158 #endif /* not HAVE_X_WINDOWS */
1160 if (new_f != 0)
1161 XSETFRAME (window, new_f);
1162 else
1164 window = selected_window;
1165 XSETFASTINT (x, 0);
1166 XSETFASTINT (y, 0);
1170 /* Decode where to put the menu. */
1172 if (FRAMEP (window))
1174 f = XFRAME (window);
1175 xpos = 0;
1176 ypos = 0;
1178 else if (WINDOWP (window))
1180 struct window *win = XWINDOW (window);
1181 CHECK_LIVE_WINDOW (window);
1182 f = XFRAME (WINDOW_FRAME (win));
1184 xpos = WINDOW_LEFT_EDGE_X (win);
1185 ypos = WINDOW_TOP_EDGE_Y (win);
1187 else
1188 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1189 but I don't want to make one now. */
1190 CHECK_WINDOW (window);
1192 CHECK_RANGED_INTEGER (x,
1193 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1194 ? (EMACS_INT) INT_MIN - xpos
1195 : MOST_NEGATIVE_FIXNUM),
1196 INT_MAX - xpos);
1197 CHECK_RANGED_INTEGER (y,
1198 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1199 ? (EMACS_INT) INT_MIN - ypos
1200 : MOST_NEGATIVE_FIXNUM),
1201 INT_MAX - ypos);
1202 xpos += XINT (x);
1203 ypos += XINT (y);
1205 /* FIXME: Find a more general check! */
1206 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1207 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1208 error ("Can not put GUI menu on this terminal");
1210 XSETFRAME (Vmenu_updating_frame, f);
1212 #endif /* HAVE_MENUS */
1214 /* Now parse the lisp menus. */
1215 record_unwind_protect (unuse_menu_items, Qnil);
1217 title = Qnil;
1218 GCPRO1 (title);
1220 /* Decode the menu items from what was specified. */
1222 keymap = get_keymap (menu, 0, 0);
1223 if (CONSP (keymap))
1225 /* We were given a keymap. Extract menu info from the keymap. */
1226 Lisp_Object prompt;
1228 /* Extract the detailed info to make one pane. */
1229 keymap_panes (&menu, 1);
1231 /* Search for a string appearing directly as an element of the keymap.
1232 That string is the title of the menu. */
1233 prompt = Fkeymap_prompt (keymap);
1234 if (!NILP (prompt))
1235 title = prompt;
1236 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1237 else
1238 title = build_string ("Select");
1239 #endif
1241 /* Make that be the pane title of the first pane. */
1242 if (!NILP (prompt) && menu_items_n_panes >= 0)
1243 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1245 keymaps = 1;
1247 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1249 /* We were given a list of keymaps. */
1250 EMACS_INT nmaps = XFASTINT (Flength (menu));
1251 Lisp_Object *maps;
1252 ptrdiff_t i;
1253 USE_SAFE_ALLOCA;
1255 SAFE_ALLOCA_LISP (maps, nmaps);
1256 title = Qnil;
1258 /* The first keymap that has a prompt string
1259 supplies the menu title. */
1260 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1262 Lisp_Object prompt;
1264 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1266 prompt = Fkeymap_prompt (keymap);
1267 if (NILP (title) && !NILP (prompt))
1268 title = prompt;
1271 /* Extract the detailed info to make one pane. */
1272 keymap_panes (maps, nmaps);
1274 /* Make the title be the pane title of the first pane. */
1275 if (!NILP (title) && menu_items_n_panes >= 0)
1276 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1278 keymaps = 1;
1280 SAFE_FREE ();
1282 else
1284 /* We were given an old-fashioned menu. */
1285 title = Fcar (menu);
1286 CHECK_STRING (title);
1288 list_of_panes (Fcdr (menu));
1290 keymaps = 0;
1293 unbind_to (specpdl_count, Qnil);
1295 #ifdef HAVE_MENUS
1296 #ifdef HAVE_WINDOW_SYSTEM
1297 /* Hide a previous tip, if any. */
1298 Fx_hide_tip ();
1299 #endif
1301 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1302 /* If resources from a previous popup menu still exist, does nothing
1303 until the `menu_free_timer' has freed them (see w32fns.c). This
1304 can occur if you press ESC or click outside a menu without selecting
1305 a menu item.
1307 if (current_popup_menu)
1309 discard_menu_items ();
1310 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1311 UNGCPRO;
1312 return Qnil;
1314 #endif
1316 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1317 record_unwind_protect (cleanup_popup_menu, Qnil);
1318 #endif
1320 /* Display them in a menu. */
1321 block_input ();
1323 /* FIXME: Use a terminal hook! */
1324 #if defined HAVE_NTGUI
1325 selection = w32_menu_show (f, xpos, ypos, for_click,
1326 keymaps, title, &error_name);
1327 #elif defined HAVE_NS
1328 selection = ns_menu_show (f, xpos, ypos, for_click,
1329 keymaps, title, &error_name);
1330 #else /* MSDOS and X11 */
1331 /* Assume last_event_timestamp is the timestamp of the button event.
1332 Is this assumption ever violated? We can't use the timestamp
1333 stored within POSITION because there the top bits from the actual
1334 timestamp may be truncated away (Bug#4930). */
1335 selection = xmenu_show (f, xpos, ypos, for_click,
1336 keymaps, title, &error_name,
1337 last_event_timestamp);
1338 #endif
1340 unblock_input ();
1342 #ifdef HAVE_NS
1343 unbind_to (specpdl_count, Qnil);
1344 #else
1345 discard_menu_items ();
1346 #endif
1348 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1349 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1350 #endif
1352 #endif /* HAVE_MENUS */
1354 UNGCPRO;
1356 if (error_name) error ("%s", error_name);
1357 return selection;
1360 void
1361 syms_of_menu (void)
1363 staticpro (&menu_items);
1364 menu_items = Qnil;
1365 menu_items_inuse = Qnil;
1367 defsubr (&Sx_popup_menu);