* elisp.texi (DATE): Forgot to change the month in 2012-04-21 change.
[emacs.git] / src / menu.c
blobdf86208c7ef726b572a35c2dfd2fb44391ece84a
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 <setjmp.h>
24 #include <limits.h> /* for INT_MAX */
26 #include "lisp.h"
27 #include "keyboard.h"
28 #include "keymap.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "termhooks.h"
32 #include "blockinput.h"
33 #include "dispextern.h"
35 #ifdef USE_X_TOOLKIT
36 #include "../lwlib/lwlib.h"
37 #endif
39 #ifdef HAVE_X_WINDOWS
40 #include "xterm.h"
41 #endif
43 #ifdef HAVE_NS
44 #include "nsterm.h"
45 #endif
47 #ifdef USE_GTK
48 #include "gtkutil.h"
49 #endif
51 #ifdef HAVE_NTGUI
52 #include "w32term.h"
54 extern AppendMenuW_Proc unicode_append_menu;
55 extern HMENU current_popup_menu;
57 #endif /* HAVE_NTGUI */
59 #include "menu.h"
61 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
62 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
63 #define HAVE_BOXES 1
64 #endif
66 Lisp_Object menu_items;
68 /* If non-nil, means that the global vars defined here are already in use.
69 Used to detect cases where we try to re-enter this non-reentrant code. */
70 #if ! (defined USE_GTK || defined USE_MOTIF)
71 static
72 #endif
73 Lisp_Object menu_items_inuse;
75 /* Number of slots currently allocated in menu_items. */
76 int menu_items_allocated;
78 /* This is the index in menu_items of the first empty slot. */
79 int menu_items_used;
81 /* The number of panes currently recorded in menu_items,
82 excluding those within submenus. */
83 int menu_items_n_panes;
85 /* Current depth within submenus. */
86 static int menu_items_submenu_depth;
88 void
89 init_menu_items (void)
91 if (!NILP (menu_items_inuse))
92 error ("Trying to use a menu from within a menu-entry");
94 if (NILP (menu_items))
96 menu_items_allocated = 60;
97 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
100 menu_items_inuse = Qt;
101 menu_items_used = 0;
102 menu_items_n_panes = 0;
103 menu_items_submenu_depth = 0;
106 /* Call at the end of generating the data in menu_items. */
108 void
109 finish_menu_items (void)
113 Lisp_Object
114 unuse_menu_items (Lisp_Object dummy)
116 return menu_items_inuse = Qnil;
119 /* Call when finished using the data for the current menu
120 in menu_items. */
122 void
123 discard_menu_items (void)
125 /* Free the structure if it is especially large.
126 Otherwise, hold on to it, to save time. */
127 if (menu_items_allocated > 200)
129 menu_items = Qnil;
130 menu_items_allocated = 0;
132 xassert (NILP (menu_items_inuse));
135 #ifdef HAVE_NS
136 static Lisp_Object
137 cleanup_popup_menu (Lisp_Object arg)
139 discard_menu_items ();
140 return Qnil;
142 #endif
144 /* This undoes save_menu_items, and it is called by the specpdl unwind
145 mechanism. */
147 static Lisp_Object
148 restore_menu_items (Lisp_Object saved)
150 menu_items = XCAR (saved);
151 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
152 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
153 saved = XCDR (saved);
154 menu_items_used = XINT (XCAR (saved));
155 saved = XCDR (saved);
156 menu_items_n_panes = XINT (XCAR (saved));
157 saved = XCDR (saved);
158 menu_items_submenu_depth = XINT (XCAR (saved));
159 return Qnil;
162 /* Push the whole state of menu_items processing onto the specpdl.
163 It will be restored when the specpdl is unwound. */
165 void
166 save_menu_items (void)
168 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
169 make_number (menu_items_used),
170 make_number (menu_items_n_panes),
171 make_number (menu_items_submenu_depth));
172 record_unwind_protect (restore_menu_items, saved);
173 menu_items_inuse = Qnil;
174 menu_items = Qnil;
178 /* Make the menu_items vector twice as large. */
180 static void
181 grow_menu_items (void)
183 if ((INT_MAX - MENU_ITEMS_PANE_LENGTH) / 2 < menu_items_allocated)
184 memory_full (SIZE_MAX);
185 menu_items_allocated *= 2;
186 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
189 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
190 || defined HAVE_NTGUI)
192 /* Begin a submenu. */
194 static void
195 push_submenu_start (void)
197 if (menu_items_used + 1 > menu_items_allocated)
198 grow_menu_items ();
200 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
201 menu_items_submenu_depth++;
204 /* End a submenu. */
206 static void
207 push_submenu_end (void)
209 if (menu_items_used + 1 > menu_items_allocated)
210 grow_menu_items ();
212 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
213 menu_items_submenu_depth--;
216 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
218 /* Indicate boundary between left and right. */
220 static void
221 push_left_right_boundary (void)
223 if (menu_items_used + 1 > menu_items_allocated)
224 grow_menu_items ();
226 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
229 /* Start a new menu pane in menu_items.
230 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
232 static void
233 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
235 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
236 grow_menu_items ();
238 if (menu_items_submenu_depth == 0)
239 menu_items_n_panes++;
240 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
241 XVECTOR (menu_items)->contents[menu_items_used++] = name;
242 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
245 /* Push one menu item into the current pane. NAME is the string to
246 display. ENABLE if non-nil means this item can be selected. KEY
247 is the key generated by choosing this item, or nil if this item
248 doesn't really have a definition. DEF is the definition of this
249 item. EQUIV is the textual description of the keyboard equivalent
250 for this item (or nil if none). TYPE is the type of this menu
251 item, one of nil, `toggle' or `radio'. */
253 static void
254 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)
256 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
257 grow_menu_items ();
259 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
260 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
261 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
262 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
263 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
264 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
265 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
266 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
268 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
271 /* Args passed between single_keymap_panes and single_menu_item. */
272 struct skp
274 Lisp_Object pending_maps;
275 int maxdepth;
276 int notbuttons;
279 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
280 void *);
282 /* This is a recursive subroutine of keymap_panes.
283 It handles one keymap, KEYMAP.
284 The other arguments are passed along
285 or point to local variables of the previous function.
287 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
289 static void
290 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
291 Lisp_Object prefix, int maxdepth)
293 struct skp skp;
294 struct gcpro gcpro1;
296 skp.pending_maps = Qnil;
297 skp.maxdepth = maxdepth;
298 skp.notbuttons = 0;
300 if (maxdepth <= 0)
301 return;
303 push_menu_pane (pane_name, prefix);
305 #ifndef HAVE_BOXES
306 /* Remember index for first item in this pane so we can go back and
307 add a prefix when (if) we see the first button. After that, notbuttons
308 is set to 0, to mark that we have seen a button and all non button
309 items need a prefix. */
310 skp.notbuttons = menu_items_used;
311 #endif
313 GCPRO1 (skp.pending_maps);
314 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
315 UNGCPRO;
317 /* Process now any submenus which want to be panes at this level. */
318 while (CONSP (skp.pending_maps))
320 Lisp_Object elt, eltcdr, string;
321 elt = XCAR (skp.pending_maps);
322 eltcdr = XCDR (elt);
323 string = XCAR (eltcdr);
324 /* We no longer discard the @ from the beginning of the string here.
325 Instead, we do this in *menu_show. */
326 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
327 skp.pending_maps = XCDR (skp.pending_maps);
331 /* This is a subroutine of single_keymap_panes that handles one
332 keymap entry.
333 KEY is a key in a keymap and ITEM is its binding.
334 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
335 separate panes.
336 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
338 static void
339 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
341 Lisp_Object map, item_string, enabled;
342 struct gcpro gcpro1, gcpro2;
343 int res;
344 struct skp *skp = skp_v;
346 /* Parse the menu item and leave the result in item_properties. */
347 GCPRO2 (key, item);
348 res = parse_menu_item (item, 0);
349 UNGCPRO;
350 if (!res)
351 return; /* Not a menu item. */
353 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
355 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
356 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
358 if (!NILP (map) && SREF (item_string, 0) == '@')
360 if (!NILP (enabled))
361 /* An enabled separate pane. Remember this to handle it later. */
362 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
363 skp->pending_maps);
364 return;
367 #if defined (HAVE_X_WINDOWS) || defined (MSDOS)
368 #ifndef HAVE_BOXES
369 /* Simulate radio buttons and toggle boxes by putting a prefix in
370 front of them. */
372 Lisp_Object prefix = Qnil;
373 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
374 if (!NILP (type))
376 Lisp_Object selected
377 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
379 if (skp->notbuttons)
380 /* The first button. Line up previous items in this menu. */
382 int idx = skp->notbuttons; /* Index for first item this menu. */
383 int submenu = 0;
384 Lisp_Object tem;
385 while (idx < menu_items_used)
388 = XVECTOR (menu_items)->contents[idx + MENU_ITEMS_ITEM_NAME];
389 if (NILP (tem))
391 idx++;
392 submenu++; /* Skip sub menu. */
394 else if (EQ (tem, Qlambda))
396 idx++;
397 submenu--; /* End sub menu. */
399 else if (EQ (tem, Qt))
400 idx += 3; /* Skip new pane marker. */
401 else if (EQ (tem, Qquote))
402 idx++; /* Skip a left, right divider. */
403 else
405 if (!submenu && SREF (tem, 0) != '\0'
406 && SREF (tem, 0) != '-')
407 XVECTOR (menu_items)->contents[idx + MENU_ITEMS_ITEM_NAME]
408 = concat2 (build_string (" "), tem);
409 idx += MENU_ITEMS_ITEM_LENGTH;
412 skp->notbuttons = 0;
415 /* Calculate prefix, if any, for this item. */
416 if (EQ (type, QCtoggle))
417 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
418 else if (EQ (type, QCradio))
419 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
421 /* Not a button. If we have earlier buttons, then we need a prefix. */
422 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
423 && SREF (item_string, 0) != '-')
424 prefix = build_string (" ");
426 if (!NILP (prefix))
427 item_string = concat2 (prefix, item_string);
429 #endif /* not HAVE_BOXES */
431 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
432 if (!NILP (map))
433 /* Indicate visually that this is a submenu. */
434 item_string = concat2 (item_string, build_string (" >"));
435 #endif
437 #endif /* HAVE_X_WINDOWS || MSDOS */
439 push_menu_item (item_string, enabled, key,
440 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
441 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
442 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
443 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
444 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
446 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
447 /* Display a submenu using the toolkit. */
448 if (! (NILP (map) || NILP (enabled)))
450 push_submenu_start ();
451 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
452 push_submenu_end ();
454 #endif
457 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
458 and generate menu panes for them in menu_items. */
460 static void
461 keymap_panes (Lisp_Object *keymaps, int nmaps)
463 int mapno;
465 init_menu_items ();
467 /* Loop over the given keymaps, making a pane for each map.
468 But don't make a pane that is empty--ignore that map instead.
469 P is the number of panes we have made so far. */
470 for (mapno = 0; mapno < nmaps; mapno++)
471 single_keymap_panes (keymaps[mapno],
472 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
474 finish_menu_items ();
478 /* Push the items in a single pane defined by the alist PANE. */
479 static void
480 list_of_items (Lisp_Object pane)
482 Lisp_Object tail, item, item1;
484 for (tail = pane; CONSP (tail); tail = XCDR (tail))
486 item = XCAR (tail);
487 if (STRINGP (item))
488 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
489 Qnil, Qnil, Qnil, Qnil);
490 else if (CONSP (item))
492 item1 = XCAR (item);
493 CHECK_STRING (item1);
494 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
495 Qt, Qnil, Qnil, Qnil, Qnil);
497 else
498 push_left_right_boundary ();
503 /* Push all the panes and items of a menu described by the
504 alist-of-alists MENU.
505 This handles old-fashioned calls to x-popup-menu. */
506 void
507 list_of_panes (Lisp_Object menu)
509 Lisp_Object tail;
511 init_menu_items ();
513 for (tail = menu; CONSP (tail); tail = XCDR (tail))
515 Lisp_Object elt, pane_name, pane_data;
516 elt = XCAR (tail);
517 pane_name = Fcar (elt);
518 CHECK_STRING (pane_name);
519 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
520 pane_data = Fcdr (elt);
521 CHECK_CONS (pane_data);
522 list_of_items (pane_data);
525 finish_menu_items ();
528 /* Set up data in menu_items for a menu bar item
529 whose event type is ITEM_KEY (with string ITEM_NAME)
530 and whose contents come from the list of keymaps MAPS. */
532 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
534 Lisp_Object length;
535 int len;
536 Lisp_Object *mapvec;
537 int i;
538 int top_level_items = 0;
540 length = Flength (maps);
541 len = XINT (length);
543 /* Convert the list MAPS into a vector MAPVEC. */
544 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
545 for (i = 0; i < len; i++)
547 mapvec[i] = Fcar (maps);
548 maps = Fcdr (maps);
551 /* Loop over the given keymaps, making a pane for each map.
552 But don't make a pane that is empty--ignore that map instead. */
553 for (i = 0; i < len; i++)
555 if (!KEYMAPP (mapvec[i]))
557 /* Here we have a command at top level in the menu bar
558 as opposed to a submenu. */
559 top_level_items = 1;
560 push_menu_pane (Qnil, Qnil);
561 push_menu_item (item_name, Qt, item_key, mapvec[i],
562 Qnil, Qnil, Qnil, Qnil);
564 else
566 Lisp_Object prompt;
567 prompt = Fkeymap_prompt (mapvec[i]);
568 single_keymap_panes (mapvec[i],
569 !NILP (prompt) ? prompt : item_name,
570 item_key, 10);
574 return top_level_items;
578 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
580 /* Allocate a widget_value, blocking input. */
582 widget_value *
583 xmalloc_widget_value (void)
585 widget_value *value;
587 BLOCK_INPUT;
588 value = malloc_widget_value ();
589 UNBLOCK_INPUT;
591 return value;
594 /* This recursively calls free_widget_value on the tree of widgets.
595 It must free all data that was malloc'ed for these widget_values.
596 In Emacs, many slots are pointers into the data of Lisp_Strings, and
597 must be left alone. */
599 void
600 free_menubar_widget_value_tree (widget_value *wv)
602 if (! wv) return;
604 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
606 if (wv->contents && (wv->contents != (widget_value*)1))
608 free_menubar_widget_value_tree (wv->contents);
609 wv->contents = (widget_value *) 0xDEADBEEF;
611 if (wv->next)
613 free_menubar_widget_value_tree (wv->next);
614 wv->next = (widget_value *) 0xDEADBEEF;
616 BLOCK_INPUT;
617 free_widget_value (wv);
618 UNBLOCK_INPUT;
621 /* Create a tree of widget_value objects
622 representing the panes and items
623 in menu_items starting at index START, up to index END. */
625 widget_value *
626 digest_single_submenu (int start, int end, int top_level_items)
628 widget_value *wv, *prev_wv, *save_wv, *first_wv;
629 int i;
630 int submenu_depth = 0;
631 widget_value **submenu_stack;
632 int panes_seen = 0;
634 submenu_stack
635 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
636 wv = xmalloc_widget_value ();
637 wv->name = "menu";
638 wv->value = 0;
639 wv->enabled = 1;
640 wv->button_type = BUTTON_TYPE_NONE;
641 wv->help = Qnil;
642 first_wv = wv;
643 save_wv = 0;
644 prev_wv = 0;
646 /* Loop over all panes and items made by the preceding call
647 to parse_single_submenu and construct a tree of widget_value objects.
648 Ignore the panes and items used by previous calls to
649 digest_single_submenu, even though those are also in menu_items. */
650 i = start;
651 while (i < end)
653 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
655 submenu_stack[submenu_depth++] = save_wv;
656 save_wv = prev_wv;
657 prev_wv = 0;
658 i++;
660 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
662 prev_wv = save_wv;
663 save_wv = submenu_stack[--submenu_depth];
664 i++;
666 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
667 && submenu_depth != 0)
668 i += MENU_ITEMS_PANE_LENGTH;
669 /* Ignore a nil in the item list.
670 It's meaningful only for dialog boxes. */
671 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
672 i += 1;
673 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
675 /* Create a new pane. */
676 Lisp_Object pane_name;
677 const char *pane_string;
679 panes_seen++;
681 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
683 #ifdef HAVE_NTGUI
684 if (STRINGP (pane_name))
686 if (unicode_append_menu)
687 /* Encode as UTF-8 for now. */
688 pane_name = ENCODE_UTF_8 (pane_name);
689 else if (STRING_MULTIBYTE (pane_name))
690 pane_name = ENCODE_SYSTEM (pane_name);
692 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
694 #elif defined (USE_LUCID) && defined (HAVE_XFT)
695 if (STRINGP (pane_name))
697 pane_name = ENCODE_UTF_8 (pane_name);
698 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
700 #elif !defined (HAVE_MULTILINGUAL_MENU)
701 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
703 pane_name = ENCODE_MENU_STRING (pane_name);
704 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
706 #endif
708 pane_string = (NILP (pane_name)
709 ? "" : SSDATA (pane_name));
710 /* If there is just one top-level pane, put all its items directly
711 under the top-level menu. */
712 if (menu_items_n_panes == 1)
713 pane_string = "";
715 /* If the pane has a meaningful name,
716 make the pane a top-level menu item
717 with its items as a submenu beneath it. */
718 if (strcmp (pane_string, ""))
720 wv = xmalloc_widget_value ();
721 if (save_wv)
722 save_wv->next = wv;
723 else
724 first_wv->contents = wv;
725 wv->lname = pane_name;
726 /* Set value to 1 so update_submenu_strings can handle '@' */
727 wv->value = (char *)1;
728 wv->enabled = 1;
729 wv->button_type = BUTTON_TYPE_NONE;
730 wv->help = Qnil;
731 save_wv = wv;
733 else
734 save_wv = first_wv;
736 prev_wv = 0;
737 i += MENU_ITEMS_PANE_LENGTH;
739 else
741 /* Create a new item within current pane. */
742 Lisp_Object item_name, enable, descrip, def, type, selected;
743 Lisp_Object help;
745 /* All items should be contained in panes. */
746 if (panes_seen == 0)
747 abort ();
749 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
750 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
751 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
752 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
753 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
754 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
755 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
757 #ifdef HAVE_NTGUI
758 if (STRINGP (item_name))
760 if (unicode_append_menu)
761 item_name = ENCODE_UTF_8 (item_name);
762 else if (STRING_MULTIBYTE (item_name))
763 item_name = ENCODE_SYSTEM (item_name);
765 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
768 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
770 descrip = ENCODE_SYSTEM (descrip);
771 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
773 #elif USE_LUCID
774 if (STRINGP (item_name))
776 item_name = ENCODE_UTF_8 (item_name);
777 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
780 if (STRINGP (descrip))
782 descrip = ENCODE_UTF_8 (descrip);
783 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
785 #elif !defined (HAVE_MULTILINGUAL_MENU)
786 if (STRING_MULTIBYTE (item_name))
788 item_name = ENCODE_MENU_STRING (item_name);
789 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
792 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
794 descrip = ENCODE_MENU_STRING (descrip);
795 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
797 #endif
799 wv = xmalloc_widget_value ();
800 if (prev_wv)
801 prev_wv->next = wv;
802 else
803 save_wv->contents = wv;
805 wv->lname = item_name;
806 if (!NILP (descrip))
807 wv->lkey = descrip;
808 wv->value = 0;
809 /* The intptr_t cast avoids a warning. There's no problem
810 as long as pointers have enough bits to hold small integers. */
811 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
812 wv->enabled = !NILP (enable);
814 if (NILP (type))
815 wv->button_type = BUTTON_TYPE_NONE;
816 else if (EQ (type, QCradio))
817 wv->button_type = BUTTON_TYPE_RADIO;
818 else if (EQ (type, QCtoggle))
819 wv->button_type = BUTTON_TYPE_TOGGLE;
820 else
821 abort ();
823 wv->selected = !NILP (selected);
824 if (! STRINGP (help))
825 help = Qnil;
827 wv->help = help;
829 prev_wv = wv;
831 i += MENU_ITEMS_ITEM_LENGTH;
835 /* If we have just one "menu item"
836 that was originally a button, return it by itself. */
837 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
839 wv = first_wv->contents;
840 free_widget_value (first_wv);
841 return wv;
844 return first_wv;
847 /* Walk through the widget_value tree starting at FIRST_WV and update
848 the char * pointers from the corresponding lisp values.
849 We do this after building the whole tree, since GC may happen while the
850 tree is constructed, and small strings are relocated. So we must wait
851 until no GC can happen before storing pointers into lisp values. */
852 void
853 update_submenu_strings (widget_value *first_wv)
855 widget_value *wv;
857 for (wv = first_wv; wv; wv = wv->next)
859 if (STRINGP (wv->lname))
861 wv->name = SSDATA (wv->lname);
863 /* Ignore the @ that means "separate pane".
864 This is a kludge, but this isn't worth more time. */
865 if (wv->value == (char *)1)
867 if (wv->name[0] == '@')
868 wv->name++;
869 wv->value = 0;
873 if (STRINGP (wv->lkey))
874 wv->key = SSDATA (wv->lkey);
876 if (wv->contents)
877 update_submenu_strings (wv->contents);
881 /* Find the menu selection and store it in the keyboard buffer.
882 F is the frame the menu is on.
883 MENU_BAR_ITEMS_USED is the length of VECTOR.
884 VECTOR is an array of menu events for the whole menu. */
886 void
887 find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
889 Lisp_Object prefix, entry;
890 Lisp_Object *subprefix_stack;
891 int submenu_depth = 0;
892 int i;
894 entry = Qnil;
895 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
896 prefix = Qnil;
897 i = 0;
899 while (i < menu_bar_items_used)
901 if (EQ (XVECTOR (vector)->contents[i], Qnil))
903 subprefix_stack[submenu_depth++] = prefix;
904 prefix = entry;
905 i++;
907 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
909 prefix = subprefix_stack[--submenu_depth];
910 i++;
912 else if (EQ (XVECTOR (vector)->contents[i], Qt))
914 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
915 i += MENU_ITEMS_PANE_LENGTH;
917 else
919 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
920 /* Treat the pointer as an integer. There's no problem
921 as long as pointers have enough bits to hold small integers. */
922 if ((intptr_t) client_data == i)
924 int j;
925 struct input_event buf;
926 Lisp_Object frame;
927 EVENT_INIT (buf);
929 XSETFRAME (frame, f);
930 buf.kind = MENU_BAR_EVENT;
931 buf.frame_or_window = frame;
932 buf.arg = frame;
933 kbd_buffer_store_event (&buf);
935 for (j = 0; j < submenu_depth; j++)
936 if (!NILP (subprefix_stack[j]))
938 buf.kind = MENU_BAR_EVENT;
939 buf.frame_or_window = frame;
940 buf.arg = subprefix_stack[j];
941 kbd_buffer_store_event (&buf);
944 if (!NILP (prefix))
946 buf.kind = MENU_BAR_EVENT;
947 buf.frame_or_window = frame;
948 buf.arg = prefix;
949 kbd_buffer_store_event (&buf);
952 buf.kind = MENU_BAR_EVENT;
953 buf.frame_or_window = frame;
954 buf.arg = entry;
955 kbd_buffer_store_event (&buf);
957 return;
959 i += MENU_ITEMS_ITEM_LENGTH;
964 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
966 #ifdef HAVE_NS
967 /* As above, but return the menu selection instead of storing in kb buffer.
968 If keymaps==1, return full prefixes to selection. */
969 Lisp_Object
970 find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
972 Lisp_Object prefix, entry;
973 int i;
974 Lisp_Object *subprefix_stack;
975 int submenu_depth = 0;
977 prefix = entry = Qnil;
978 i = 0;
979 subprefix_stack =
980 (Lisp_Object *)alloca (menu_items_used * sizeof (Lisp_Object));
982 while (i < menu_items_used)
984 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
986 subprefix_stack[submenu_depth++] = prefix;
987 prefix = entry;
988 i++;
990 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
992 prefix = subprefix_stack[--submenu_depth];
993 i++;
995 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
997 prefix
998 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
999 i += MENU_ITEMS_PANE_LENGTH;
1001 /* Ignore a nil in the item list.
1002 It's meaningful only for dialog boxes. */
1003 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1004 i += 1;
1005 else
1007 entry
1008 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1009 if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
1011 if (keymaps != 0)
1013 int j;
1015 entry = Fcons (entry, Qnil);
1016 if (!NILP (prefix))
1017 entry = Fcons (prefix, entry);
1018 for (j = submenu_depth - 1; j >= 0; j--)
1019 if (!NILP (subprefix_stack[j]))
1020 entry = Fcons (subprefix_stack[j], entry);
1022 return entry;
1024 i += MENU_ITEMS_ITEM_LENGTH;
1027 return Qnil;
1029 #endif /* HAVE_NS */
1031 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1032 doc: /* Pop up a deck-of-cards menu and return user's selection.
1033 POSITION is a position specification. This is either a mouse button event
1034 or a list ((XOFFSET YOFFSET) WINDOW)
1035 where XOFFSET and YOFFSET are positions in pixels from the top left
1036 corner of WINDOW. (WINDOW may be a window or a frame object.)
1037 This controls the position of the top left of the menu as a whole.
1038 If POSITION is t, it means to use the current mouse position.
1040 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1041 The menu items come from key bindings that have a menu string as well as
1042 a definition; actually, the "definition" in such a key binding looks like
1043 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1044 the keymap as a top-level element.
1046 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1047 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1049 You can also use a list of keymaps as MENU.
1050 Then each keymap makes a separate pane.
1052 When MENU is a keymap or a list of keymaps, the return value is the
1053 list of events corresponding to the user's choice. Note that
1054 `x-popup-menu' does not actually execute the command bound to that
1055 sequence of events.
1057 Alternatively, you can specify a menu of multiple panes
1058 with a list of the form (TITLE PANE1 PANE2...),
1059 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1060 Each ITEM is normally a cons cell (STRING . VALUE);
1061 but a string can appear as an item--that makes a nonselectable line
1062 in the menu.
1063 With this form of menu, the return value is VALUE from the chosen item.
1065 If POSITION is nil, don't display the menu at all, just precalculate the
1066 cached information about equivalent key sequences.
1068 If the user gets rid of the menu without making a valid choice, for
1069 instance by clicking the mouse away from a valid choice or by typing
1070 keyboard input, then this normally results in a quit and
1071 `x-popup-menu' does not return. But if POSITION is a mouse button
1072 event (indicating that the user invoked the menu with the mouse) then
1073 no quit occurs and `x-popup-menu' returns nil. */)
1074 (Lisp_Object position, Lisp_Object menu)
1076 Lisp_Object keymap, tem;
1077 int xpos = 0, ypos = 0;
1078 Lisp_Object title;
1079 const char *error_name = NULL;
1080 Lisp_Object selection = Qnil;
1081 FRAME_PTR f = NULL;
1082 Lisp_Object x, y, window;
1083 int keymaps = 0;
1084 int for_click = 0;
1085 int specpdl_count = SPECPDL_INDEX ();
1086 struct gcpro gcpro1;
1088 if (NILP (position))
1089 /* This is an obsolete call, which wants us to precompute the
1090 keybinding equivalents, but we don't do that any more anyway. */
1091 return Qnil;
1093 #ifdef HAVE_MENUS
1095 int get_current_pos_p = 0;
1096 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1098 /* Decode the first argument: find the window and the coordinates. */
1099 if (EQ (position, Qt)
1100 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1101 || EQ (XCAR (position), Qtool_bar))))
1103 get_current_pos_p = 1;
1105 else
1107 tem = Fcar (position);
1108 if (CONSP (tem))
1110 window = Fcar (Fcdr (position));
1111 x = XCAR (tem);
1112 y = Fcar (XCDR (tem));
1114 else
1116 for_click = 1;
1117 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1118 window = Fcar (tem); /* POSN_WINDOW (tem) */
1119 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1120 x = Fcar (tem);
1121 y = Fcdr (tem);
1124 /* If a click happens in an external tool bar or a detached
1125 tool bar, x and y is NIL. In that case, use the current
1126 mouse position. This happens for the help button in the
1127 tool bar. Ideally popup-menu should pass NIL to
1128 this function, but it doesn't. */
1129 if (NILP (x) && NILP (y))
1130 get_current_pos_p = 1;
1133 if (get_current_pos_p)
1135 /* Use the mouse's current position. */
1136 FRAME_PTR new_f = SELECTED_FRAME ();
1137 #ifdef HAVE_X_WINDOWS
1138 /* Can't use mouse_position_hook for X since it returns
1139 coordinates relative to the window the mouse is in,
1140 we need coordinates relative to the edit widget always. */
1141 if (new_f != 0)
1143 int cur_x, cur_y;
1145 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1146 /* cur_x/y may be negative, so use make_number. */
1147 x = make_number (cur_x);
1148 y = make_number (cur_y);
1151 #else /* not HAVE_X_WINDOWS */
1152 Lisp_Object bar_window;
1153 enum scroll_bar_part part;
1154 Time time;
1155 void (*mouse_position_hook) (struct frame **, int,
1156 Lisp_Object *,
1157 enum scroll_bar_part *,
1158 Lisp_Object *,
1159 Lisp_Object *,
1160 Time *) =
1161 FRAME_TERMINAL (new_f)->mouse_position_hook;
1163 if (mouse_position_hook)
1164 (*mouse_position_hook) (&new_f, 1, &bar_window,
1165 &part, &x, &y, &time);
1166 #endif /* not HAVE_X_WINDOWS */
1168 if (new_f != 0)
1169 XSETFRAME (window, new_f);
1170 else
1172 window = selected_window;
1173 XSETFASTINT (x, 0);
1174 XSETFASTINT (y, 0);
1178 CHECK_NUMBER (x);
1179 CHECK_NUMBER (y);
1181 /* Decode where to put the menu. */
1183 if (FRAMEP (window))
1185 f = XFRAME (window);
1186 xpos = 0;
1187 ypos = 0;
1189 else if (WINDOWP (window))
1191 struct window *win = XWINDOW (window);
1192 CHECK_LIVE_WINDOW (window);
1193 f = XFRAME (WINDOW_FRAME (win));
1195 xpos = WINDOW_LEFT_EDGE_X (win);
1196 ypos = WINDOW_TOP_EDGE_Y (win);
1198 else
1199 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1200 but I don't want to make one now. */
1201 CHECK_WINDOW (window);
1203 xpos += XINT (x);
1204 ypos += XINT (y);
1206 /* FIXME: Find a more general check! */
1207 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1208 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1209 error ("Can not put GUI menu on this terminal");
1211 XSETFRAME (Vmenu_updating_frame, f);
1213 #endif /* HAVE_MENUS */
1215 /* Now parse the lisp menus. */
1216 record_unwind_protect (unuse_menu_items, Qnil);
1218 title = Qnil;
1219 GCPRO1 (title);
1221 /* Decode the menu items from what was specified. */
1223 keymap = get_keymap (menu, 0, 0);
1224 if (CONSP (keymap))
1226 /* We were given a keymap. Extract menu info from the keymap. */
1227 Lisp_Object prompt;
1229 /* Extract the detailed info to make one pane. */
1230 keymap_panes (&menu, 1);
1232 /* Search for a string appearing directly as an element of the keymap.
1233 That string is the title of the menu. */
1234 prompt = Fkeymap_prompt (keymap);
1235 if (!NILP (prompt))
1236 title = prompt;
1237 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1238 else
1239 title = build_string ("Select");
1240 #endif
1242 /* Make that be the pane title of the first pane. */
1243 if (!NILP (prompt) && menu_items_n_panes >= 0)
1244 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1246 keymaps = 1;
1248 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1250 /* We were given a list of keymaps. */
1251 int nmaps = XFASTINT (Flength (menu));
1252 Lisp_Object *maps
1253 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1254 int i;
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 else
1282 /* We were given an old-fashioned menu. */
1283 title = Fcar (menu);
1284 CHECK_STRING (title);
1286 list_of_panes (Fcdr (menu));
1288 keymaps = 0;
1291 unbind_to (specpdl_count, Qnil);
1293 #ifdef HAVE_MENUS
1294 #ifdef HAVE_WINDOW_SYSTEM
1295 /* Hide a previous tip, if any. */
1296 Fx_hide_tip ();
1297 #endif
1299 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1300 /* If resources from a previous popup menu still exist, does nothing
1301 until the `menu_free_timer' has freed them (see w32fns.c). This
1302 can occur if you press ESC or click outside a menu without selecting
1303 a menu item.
1305 if (current_popup_menu)
1307 discard_menu_items ();
1308 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1309 UNGCPRO;
1310 return Qnil;
1312 #endif
1314 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1315 record_unwind_protect (cleanup_popup_menu, Qnil);
1316 #endif
1318 /* Display them in a menu. */
1319 BLOCK_INPUT;
1321 /* FIXME: Use a terminal hook! */
1322 #if defined HAVE_NTGUI
1323 selection = w32_menu_show (f, xpos, ypos, for_click,
1324 keymaps, title, &error_name);
1325 #elif defined HAVE_NS
1326 selection = ns_menu_show (f, xpos, ypos, for_click,
1327 keymaps, title, &error_name);
1328 #else /* MSDOS and X11 */
1329 /* Assume last_event_timestamp is the timestamp of the button event.
1330 Is this assumption ever violated? We can't use the timestamp
1331 stored within POSITION because there the top bits from the actual
1332 timestamp may be truncated away (Bug#4930). */
1333 selection = xmenu_show (f, xpos, ypos, for_click,
1334 keymaps, title, &error_name,
1335 last_event_timestamp);
1336 #endif
1338 UNBLOCK_INPUT;
1340 #ifdef HAVE_NS
1341 unbind_to (specpdl_count, Qnil);
1342 #else
1343 discard_menu_items ();
1344 #endif
1346 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1347 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1348 #endif
1350 #endif /* HAVE_MENUS */
1352 UNGCPRO;
1354 if (error_name) error ("%s", error_name);
1355 return selection;
1358 void
1359 syms_of_menu (void)
1361 staticpro (&menu_items);
1362 menu_items = Qnil;
1363 menu_items_inuse = Qnil;
1365 defsubr (&Sx_popup_menu);