from trunk
[emacs.git] / src / menu.c
blobad6054d7192953894816a7d3bbabb155a5437816
1 /* Platform-independent code for terminal communications.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
21 #include <stdio.h>
22 #include <setjmp.h>
24 #include "lisp.h"
25 #include "keyboard.h"
26 #include "keymap.h"
27 #include "frame.h"
28 #include "window.h"
29 #include "termhooks.h"
30 #include "blockinput.h"
31 #include "dispextern.h"
33 #ifdef USE_X_TOOLKIT
34 #include "../lwlib/lwlib.h"
35 #endif
37 #ifdef HAVE_X_WINDOWS
38 #include "xterm.h"
39 #endif
41 #ifdef HAVE_NS
42 #include "nsterm.h"
43 #endif
45 #ifdef USE_GTK
46 #include "gtkutil.h"
47 #endif
49 #ifdef HAVE_NTGUI
50 #include "w32term.h"
52 extern AppendMenuW_Proc unicode_append_menu;
53 extern HMENU current_popup_menu;
55 #endif /* HAVE_NTGUI */
57 #include "menu.h"
59 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
60 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
61 #define HAVE_BOXES 1
62 #endif
64 extern Lisp_Object QCtoggle, QCradio;
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 Lisp_Object menu_items_inuse;
72 /* Number of slots currently allocated in menu_items. */
73 int menu_items_allocated;
75 /* This is the index in menu_items of the first empty slot. */
76 int menu_items_used;
78 /* The number of panes currently recorded in menu_items,
79 excluding those within submenus. */
80 int menu_items_n_panes;
82 /* Current depth within submenus. */
83 static int menu_items_submenu_depth;
85 void
86 init_menu_items ()
88 if (!NILP (menu_items_inuse))
89 error ("Trying to use a menu from within a menu-entry");
91 if (NILP (menu_items))
93 menu_items_allocated = 60;
94 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
97 menu_items_inuse = Qt;
98 menu_items_used = 0;
99 menu_items_n_panes = 0;
100 menu_items_submenu_depth = 0;
103 /* Call at the end of generating the data in menu_items. */
105 void
106 finish_menu_items ()
110 Lisp_Object
111 unuse_menu_items (dummy)
112 Lisp_Object dummy;
114 return menu_items_inuse = Qnil;
117 /* Call when finished using the data for the current menu
118 in menu_items. */
120 void
121 discard_menu_items ()
123 /* Free the structure if it is especially large.
124 Otherwise, hold on to it, to save time. */
125 if (menu_items_allocated > 200)
127 menu_items = Qnil;
128 menu_items_allocated = 0;
130 xassert (NILP (menu_items_inuse));
133 static Lisp_Object
134 cleanup_popup_menu (Lisp_Object arg)
136 discard_menu_items ();
137 return Qnil;
140 /* This undoes save_menu_items, and it is called by the specpdl unwind
141 mechanism. */
143 static Lisp_Object
144 restore_menu_items (saved)
145 Lisp_Object saved;
147 menu_items = XCAR (saved);
148 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
149 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
150 saved = XCDR (saved);
151 menu_items_used = XINT (XCAR (saved));
152 saved = XCDR (saved);
153 menu_items_n_panes = XINT (XCAR (saved));
154 saved = XCDR (saved);
155 menu_items_submenu_depth = XINT (XCAR (saved));
156 return Qnil;
159 /* Push the whole state of menu_items processing onto the specpdl.
160 It will be restored when the specpdl is unwound. */
162 void
163 save_menu_items ()
165 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
166 make_number (menu_items_used),
167 make_number (menu_items_n_panes),
168 make_number (menu_items_submenu_depth));
169 record_unwind_protect (restore_menu_items, saved);
170 menu_items_inuse = Qnil;
171 menu_items = Qnil;
175 /* Make the menu_items vector twice as large. */
177 static void
178 grow_menu_items ()
180 menu_items_allocated *= 2;
181 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
184 /* Begin a submenu. */
186 static void
187 push_submenu_start ()
189 if (menu_items_used + 1 > menu_items_allocated)
190 grow_menu_items ();
192 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
193 menu_items_submenu_depth++;
196 /* End a submenu. */
198 static void
199 push_submenu_end ()
201 if (menu_items_used + 1 > menu_items_allocated)
202 grow_menu_items ();
204 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
205 menu_items_submenu_depth--;
208 /* Indicate boundary between left and right. */
210 static void
211 push_left_right_boundary ()
213 if (menu_items_used + 1 > menu_items_allocated)
214 grow_menu_items ();
216 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
219 /* Start a new menu pane in menu_items.
220 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
222 static void
223 push_menu_pane (name, prefix_vec)
224 Lisp_Object name, prefix_vec;
226 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
227 grow_menu_items ();
229 if (menu_items_submenu_depth == 0)
230 menu_items_n_panes++;
231 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
232 XVECTOR (menu_items)->contents[menu_items_used++] = name;
233 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
236 /* Push one menu item into the current pane. NAME is the string to
237 display. ENABLE if non-nil means this item can be selected. KEY
238 is the key generated by choosing this item, or nil if this item
239 doesn't really have a definition. DEF is the definition of this
240 item. EQUIV is the textual description of the keyboard equivalent
241 for this item (or nil if none). TYPE is the type of this menu
242 item, one of nil, `toggle' or `radio'. */
244 static void
245 push_menu_item (name, enable, key, def, equiv, type, selected, help)
246 Lisp_Object name, enable, key, def, equiv, type, selected, help;
248 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
249 grow_menu_items ();
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
252 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
253 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
254 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
255 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
256 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
257 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
258 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
260 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
263 /* Args passed between single_keymap_panes and single_menu_item. */
264 struct skp
266 Lisp_Object pending_maps;
267 int maxdepth;
268 int notbuttons;
271 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
272 void *));
274 /* This is a recursive subroutine of keymap_panes.
275 It handles one keymap, KEYMAP.
276 The other arguments are passed along
277 or point to local variables of the previous function.
279 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
281 static void
282 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
283 Lisp_Object prefix, int maxdepth)
285 struct skp skp;
286 struct gcpro gcpro1;
288 skp.pending_maps = Qnil;
289 skp.maxdepth = maxdepth;
290 skp.notbuttons = 0;
292 if (maxdepth <= 0)
293 return;
295 push_menu_pane (pane_name, prefix);
297 #ifndef HAVE_BOXES
298 /* Remember index for first item in this pane so we can go back and
299 add a prefix when (if) we see the first button. After that, notbuttons
300 is set to 0, to mark that we have seen a button and all non button
301 items need a prefix. */
302 skp.notbuttons = menu_items_used;
303 #endif
305 GCPRO1 (skp.pending_maps);
306 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
307 UNGCPRO;
309 /* Process now any submenus which want to be panes at this level. */
310 while (CONSP (skp.pending_maps))
312 Lisp_Object elt, eltcdr, string;
313 elt = XCAR (skp.pending_maps);
314 eltcdr = XCDR (elt);
315 string = XCAR (eltcdr);
316 /* We no longer discard the @ from the beginning of the string here.
317 Instead, we do this in *menu_show. */
318 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
319 skp.pending_maps = XCDR (skp.pending_maps);
323 /* This is a subroutine of single_keymap_panes that handles one
324 keymap entry.
325 KEY is a key in a keymap and ITEM is its binding.
326 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
327 separate panes.
328 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
330 static void
331 single_menu_item (key, item, dummy, skp_v)
332 Lisp_Object key, item, dummy;
333 void *skp_v;
335 Lisp_Object map, item_string, enabled;
336 struct gcpro gcpro1, gcpro2;
337 int res;
338 struct skp *skp = skp_v;
340 /* Parse the menu item and leave the result in item_properties. */
341 GCPRO2 (key, item);
342 res = parse_menu_item (item, 0);
343 UNGCPRO;
344 if (!res)
345 return; /* Not a menu item. */
347 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
349 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
350 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
352 if (!NILP (map) && SREF (item_string, 0) == '@')
354 if (!NILP (enabled))
355 /* An enabled separate pane. Remember this to handle it later. */
356 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
357 skp->pending_maps);
358 return;
361 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
362 #ifndef HAVE_BOXES
363 /* Simulate radio buttons and toggle boxes by putting a prefix in
364 front of them. */
366 Lisp_Object prefix = Qnil;
367 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
368 if (!NILP (type))
370 Lisp_Object selected
371 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
373 if (skp->notbuttons)
374 /* The first button. Line up previous items in this menu. */
376 int index = skp->notbuttons; /* Index for first item this menu. */
377 int submenu = 0;
378 Lisp_Object tem;
379 while (index < menu_items_used)
382 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
383 if (NILP (tem))
385 index++;
386 submenu++; /* Skip sub menu. */
388 else if (EQ (tem, Qlambda))
390 index++;
391 submenu--; /* End sub menu. */
393 else if (EQ (tem, Qt))
394 index += 3; /* Skip new pane marker. */
395 else if (EQ (tem, Qquote))
396 index++; /* Skip a left, right divider. */
397 else
399 if (!submenu && SREF (tem, 0) != '\0'
400 && SREF (tem, 0) != '-')
401 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
402 = concat2 (build_string (" "), tem);
403 index += MENU_ITEMS_ITEM_LENGTH;
406 skp->notbuttons = 0;
409 /* Calculate prefix, if any, for this item. */
410 if (EQ (type, QCtoggle))
411 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
412 else if (EQ (type, QCradio))
413 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
415 /* Not a button. If we have earlier buttons, then we need a prefix. */
416 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
417 && SREF (item_string, 0) != '-')
418 prefix = build_string (" ");
420 if (!NILP (prefix))
421 item_string = concat2 (prefix, item_string);
423 #endif /* not HAVE_BOXES */
425 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
426 if (!NILP (map))
427 /* Indicate visually that this is a submenu. */
428 item_string = concat2 (item_string, build_string (" >"));
429 #endif
431 #endif /* HAVE_X_WINDOWS || MSDOS */
433 push_menu_item (item_string, enabled, key,
434 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
435 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
436 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
437 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
438 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
440 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
441 /* Display a submenu using the toolkit. */
442 if (! (NILP (map) || NILP (enabled)))
444 push_submenu_start ();
445 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
446 push_submenu_end ();
448 #endif
451 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
452 and generate menu panes for them in menu_items. */
454 static void
455 keymap_panes (keymaps, nmaps)
456 Lisp_Object *keymaps;
457 int nmaps;
459 int mapno;
461 init_menu_items ();
463 /* Loop over the given keymaps, making a pane for each map.
464 But don't make a pane that is empty--ignore that map instead.
465 P is the number of panes we have made so far. */
466 for (mapno = 0; mapno < nmaps; mapno++)
467 single_keymap_panes (keymaps[mapno],
468 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
470 finish_menu_items ();
474 /* Push the items in a single pane defined by the alist PANE. */
475 static void
476 list_of_items (pane)
477 Lisp_Object pane;
479 Lisp_Object tail, item, item1;
481 for (tail = pane; CONSP (tail); tail = XCDR (tail))
483 item = XCAR (tail);
484 if (STRINGP (item))
485 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
486 Qnil, Qnil, Qnil, Qnil);
487 else if (CONSP (item))
489 item1 = XCAR (item);
490 CHECK_STRING (item1);
491 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
492 Qt, Qnil, Qnil, Qnil, Qnil);
494 else
495 push_left_right_boundary ();
500 /* Push all the panes and items of a menu described by the
501 alist-of-alists MENU.
502 This handles old-fashioned calls to x-popup-menu. */
503 void
504 list_of_panes (menu)
505 Lisp_Object menu;
507 Lisp_Object tail;
509 init_menu_items ();
511 for (tail = menu; CONSP (tail); tail = XCDR (tail))
513 Lisp_Object elt, pane_name, pane_data;
514 elt = XCAR (tail);
515 pane_name = Fcar (elt);
516 CHECK_STRING (pane_name);
517 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
518 pane_data = Fcdr (elt);
519 CHECK_CONS (pane_data);
520 list_of_items (pane_data);
523 finish_menu_items ();
526 /* Set up data in menu_items for a menu bar item
527 whose event type is ITEM_KEY (with string ITEM_NAME)
528 and whose contents come from the list of keymaps MAPS. */
530 parse_single_submenu (item_key, item_name, maps)
531 Lisp_Object item_key, item_name, maps;
533 Lisp_Object length;
534 int len;
535 Lisp_Object *mapvec;
536 int i;
537 int top_level_items = 0;
539 length = Flength (maps);
540 len = XINT (length);
542 /* Convert the list MAPS into a vector MAPVEC. */
543 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
544 for (i = 0; i < len; i++)
546 mapvec[i] = Fcar (maps);
547 maps = Fcdr (maps);
550 /* Loop over the given keymaps, making a pane for each map.
551 But don't make a pane that is empty--ignore that map instead. */
552 for (i = 0; i < len; i++)
554 if (!KEYMAPP (mapvec[i]))
556 /* Here we have a command at top level in the menu bar
557 as opposed to a submenu. */
558 top_level_items = 1;
559 push_menu_pane (Qnil, Qnil);
560 push_menu_item (item_name, Qt, item_key, mapvec[i],
561 Qnil, Qnil, Qnil, Qnil);
563 else
565 Lisp_Object prompt;
566 prompt = Fkeymap_prompt (mapvec[i]);
567 single_keymap_panes (mapvec[i],
568 !NILP (prompt) ? prompt : item_name,
569 item_key, 10);
573 return top_level_items;
577 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
579 /* Allocate a widget_value, blocking input. */
581 widget_value *
582 xmalloc_widget_value ()
584 widget_value *value;
586 BLOCK_INPUT;
587 value = malloc_widget_value ();
588 UNBLOCK_INPUT;
590 return value;
593 /* This recursively calls free_widget_value on the tree of widgets.
594 It must free all data that was malloc'ed for these widget_values.
595 In Emacs, many slots are pointers into the data of Lisp_Strings, and
596 must be left alone. */
598 void
599 free_menubar_widget_value_tree (wv)
600 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 (start, end, top_level_items)
627 int start, end, top_level_items;
629 widget_value *wv, *prev_wv, *save_wv, *first_wv;
630 int i;
631 int submenu_depth = 0;
632 widget_value **submenu_stack;
633 int panes_seen = 0;
635 submenu_stack
636 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
637 wv = xmalloc_widget_value ();
638 wv->name = "menu";
639 wv->value = 0;
640 wv->enabled = 1;
641 wv->button_type = BUTTON_TYPE_NONE;
642 wv->help = Qnil;
643 first_wv = wv;
644 save_wv = 0;
645 prev_wv = 0;
647 /* Loop over all panes and items made by the preceding call
648 to parse_single_submenu and construct a tree of widget_value objects.
649 Ignore the panes and items used by previous calls to
650 digest_single_submenu, even though those are also in menu_items. */
651 i = start;
652 while (i < end)
654 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
656 submenu_stack[submenu_depth++] = save_wv;
657 save_wv = prev_wv;
658 prev_wv = 0;
659 i++;
661 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
663 prev_wv = save_wv;
664 save_wv = submenu_stack[--submenu_depth];
665 i++;
667 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
668 && submenu_depth != 0)
669 i += MENU_ITEMS_PANE_LENGTH;
670 /* Ignore a nil in the item list.
671 It's meaningful only for dialog boxes. */
672 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
673 i += 1;
674 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
676 /* Create a new pane. */
677 Lisp_Object pane_name, prefix;
678 char *pane_string;
680 panes_seen++;
682 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
683 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
685 #ifdef HAVE_NTGUI
686 if (STRINGP (pane_name))
688 if (unicode_append_menu)
689 /* Encode as UTF-8 for now. */
690 pane_name = ENCODE_UTF_8 (pane_name);
691 else if (STRING_MULTIBYTE (pane_name))
692 pane_name = ENCODE_SYSTEM (pane_name);
694 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
696 #elif !defined (HAVE_MULTILINGUAL_MENU)
697 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
699 pane_name = ENCODE_MENU_STRING (pane_name);
700 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
702 #endif
704 pane_string = (NILP (pane_name)
705 ? "" : (char *) SDATA (pane_name));
706 /* If there is just one top-level pane, put all its items directly
707 under the top-level menu. */
708 if (menu_items_n_panes == 1)
709 pane_string = "";
711 /* If the pane has a meaningful name,
712 make the pane a top-level menu item
713 with its items as a submenu beneath it. */
714 if (strcmp (pane_string, ""))
716 wv = xmalloc_widget_value ();
717 if (save_wv)
718 save_wv->next = wv;
719 else
720 first_wv->contents = wv;
721 wv->lname = pane_name;
722 /* Set value to 1 so update_submenu_strings can handle '@' */
723 wv->value = (char *)1;
724 wv->enabled = 1;
725 wv->button_type = BUTTON_TYPE_NONE;
726 wv->help = Qnil;
727 save_wv = wv;
729 else
730 save_wv = first_wv;
732 prev_wv = 0;
733 i += MENU_ITEMS_PANE_LENGTH;
735 else
737 /* Create a new item within current pane. */
738 Lisp_Object item_name, enable, descrip, def, type, selected;
739 Lisp_Object help;
741 /* All items should be contained in panes. */
742 if (panes_seen == 0)
743 abort ();
745 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
746 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
747 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
748 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
749 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
750 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
751 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
753 #ifdef HAVE_NTGUI
754 if (STRINGP (item_name))
756 if (unicode_append_menu)
757 item_name = ENCODE_UTF_8 (item_name);
758 else if (STRING_MULTIBYTE (item_name))
759 item_name = ENCODE_SYSTEM (item_name);
761 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
764 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
766 descrip = ENCODE_SYSTEM (descrip);
767 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
769 #elif !defined (HAVE_MULTILINGUAL_MENU)
770 if (STRING_MULTIBYTE (item_name))
772 item_name = ENCODE_MENU_STRING (item_name);
773 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
776 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
778 descrip = ENCODE_MENU_STRING (descrip);
779 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
781 #endif
783 wv = xmalloc_widget_value ();
784 if (prev_wv)
785 prev_wv->next = wv;
786 else
787 save_wv->contents = wv;
789 wv->lname = item_name;
790 if (!NILP (descrip))
791 wv->lkey = descrip;
792 wv->value = 0;
793 /* The EMACS_INT cast avoids a warning. There's no problem
794 as long as pointers have enough bits to hold small integers. */
795 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
796 wv->enabled = !NILP (enable);
798 if (NILP (type))
799 wv->button_type = BUTTON_TYPE_NONE;
800 else if (EQ (type, QCradio))
801 wv->button_type = BUTTON_TYPE_RADIO;
802 else if (EQ (type, QCtoggle))
803 wv->button_type = BUTTON_TYPE_TOGGLE;
804 else
805 abort ();
807 wv->selected = !NILP (selected);
808 if (! STRINGP (help))
809 help = Qnil;
811 wv->help = help;
813 prev_wv = wv;
815 i += MENU_ITEMS_ITEM_LENGTH;
819 /* If we have just one "menu item"
820 that was originally a button, return it by itself. */
821 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
823 wv = first_wv->contents;
824 free_widget_value (first_wv);
825 return wv;
828 return first_wv;
831 /* Walk through the widget_value tree starting at FIRST_WV and update
832 the char * pointers from the corresponding lisp values.
833 We do this after building the whole tree, since GC may happen while the
834 tree is constructed, and small strings are relocated. So we must wait
835 until no GC can happen before storing pointers into lisp values. */
836 void
837 update_submenu_strings (first_wv)
838 widget_value *first_wv;
840 widget_value *wv;
842 for (wv = first_wv; wv; wv = wv->next)
844 if (STRINGP (wv->lname))
846 wv->name = (char *) SDATA (wv->lname);
848 /* Ignore the @ that means "separate pane".
849 This is a kludge, but this isn't worth more time. */
850 if (wv->value == (char *)1)
852 if (wv->name[0] == '@')
853 wv->name++;
854 wv->value = 0;
858 if (STRINGP (wv->lkey))
859 wv->key = (char *) SDATA (wv->lkey);
861 if (wv->contents)
862 update_submenu_strings (wv->contents);
866 /* Find the menu selection and store it in the keyboard buffer.
867 F is the frame the menu is on.
868 MENU_BAR_ITEMS_USED is the length of VECTOR.
869 VECTOR is an array of menu events for the whole menu. */
871 void
872 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
873 FRAME_PTR f;
874 int menu_bar_items_used;
875 Lisp_Object vector;
876 void *client_data;
878 Lisp_Object prefix, entry;
879 Lisp_Object *subprefix_stack;
880 int submenu_depth = 0;
881 int i;
883 entry = Qnil;
884 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
885 prefix = Qnil;
886 i = 0;
888 while (i < menu_bar_items_used)
890 if (EQ (XVECTOR (vector)->contents[i], Qnil))
892 subprefix_stack[submenu_depth++] = prefix;
893 prefix = entry;
894 i++;
896 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
898 prefix = subprefix_stack[--submenu_depth];
899 i++;
901 else if (EQ (XVECTOR (vector)->contents[i], Qt))
903 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
904 i += MENU_ITEMS_PANE_LENGTH;
906 else
908 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
909 /* The EMACS_INT cast avoids a warning. There's no problem
910 as long as pointers have enough bits to hold small integers. */
911 if ((int) (EMACS_INT) client_data == i)
913 int j;
914 struct input_event buf;
915 Lisp_Object frame;
916 EVENT_INIT (buf);
918 XSETFRAME (frame, f);
919 buf.kind = MENU_BAR_EVENT;
920 buf.frame_or_window = frame;
921 buf.arg = frame;
922 kbd_buffer_store_event (&buf);
924 for (j = 0; j < submenu_depth; j++)
925 if (!NILP (subprefix_stack[j]))
927 buf.kind = MENU_BAR_EVENT;
928 buf.frame_or_window = frame;
929 buf.arg = subprefix_stack[j];
930 kbd_buffer_store_event (&buf);
933 if (!NILP (prefix))
935 buf.kind = MENU_BAR_EVENT;
936 buf.frame_or_window = frame;
937 buf.arg = prefix;
938 kbd_buffer_store_event (&buf);
941 buf.kind = MENU_BAR_EVENT;
942 buf.frame_or_window = frame;
943 buf.arg = entry;
944 kbd_buffer_store_event (&buf);
946 return;
948 i += MENU_ITEMS_ITEM_LENGTH;
953 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
955 #ifdef HAVE_NS
956 /* As above, but return the menu selection instead of storing in kb buffer.
957 If keymaps==1, return full prefixes to selection. */
958 Lisp_Object
959 find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
961 Lisp_Object prefix, entry;
962 int i;
963 Lisp_Object *subprefix_stack;
964 int submenu_depth = 0;
966 prefix = entry = Qnil;
967 i = 0;
968 subprefix_stack =
969 (Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
971 while (i < menu_items_used)
973 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
975 subprefix_stack[submenu_depth++] = prefix;
976 prefix = entry;
977 i++;
979 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
981 prefix = subprefix_stack[--submenu_depth];
982 i++;
984 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
986 prefix
987 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
988 i += MENU_ITEMS_PANE_LENGTH;
990 /* Ignore a nil in the item list.
991 It's meaningful only for dialog boxes. */
992 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
993 i += 1;
994 else
996 entry
997 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
998 if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
1000 if (keymaps != 0)
1002 int j;
1004 entry = Fcons (entry, Qnil);
1005 if (!NILP (prefix))
1006 entry = Fcons (prefix, entry);
1007 for (j = submenu_depth - 1; j >= 0; j--)
1008 if (!NILP (subprefix_stack[j]))
1009 entry = Fcons (subprefix_stack[j], entry);
1011 return entry;
1013 i += MENU_ITEMS_ITEM_LENGTH;
1016 return Qnil;
1018 #endif /* HAVE_NS */
1020 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1021 doc: /* Pop up a deck-of-cards menu and return user's selection.
1022 POSITION is a position specification. This is either a mouse button event
1023 or a list ((XOFFSET YOFFSET) WINDOW)
1024 where XOFFSET and YOFFSET are positions in pixels from the top left
1025 corner of WINDOW. (WINDOW may be a window or a frame object.)
1026 This controls the position of the top left of the menu as a whole.
1027 If POSITION is t, it means to use the current mouse position.
1029 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1030 The menu items come from key bindings that have a menu string as well as
1031 a definition; actually, the "definition" in such a key binding looks like
1032 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1033 the keymap as a top-level element.
1035 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1036 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1038 You can also use a list of keymaps as MENU.
1039 Then each keymap makes a separate pane.
1041 When MENU is a keymap or a list of keymaps, the return value is the
1042 list of events corresponding to the user's choice. Note that
1043 `x-popup-menu' does not actually execute the command bound to that
1044 sequence of events.
1046 Alternatively, you can specify a menu of multiple panes
1047 with a list of the form (TITLE PANE1 PANE2...),
1048 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1049 Each ITEM is normally a cons cell (STRING . VALUE);
1050 but a string can appear as an item--that makes a nonselectable line
1051 in the menu.
1052 With this form of menu, the return value is VALUE from the chosen item.
1054 If POSITION is nil, don't display the menu at all, just precalculate the
1055 cached information about equivalent key sequences.
1057 If the user gets rid of the menu without making a valid choice, for
1058 instance by clicking the mouse away from a valid choice or by typing
1059 keyboard input, then this normally results in a quit and
1060 `x-popup-menu' does not return. But if POSITION is a mouse button
1061 event (indicating that the user invoked the menu with the mouse) then
1062 no quit occurs and `x-popup-menu' returns nil. */)
1063 (position, menu)
1064 Lisp_Object position, menu;
1066 Lisp_Object keymap, tem;
1067 int xpos = 0, ypos = 0;
1068 Lisp_Object title;
1069 char *error_name = NULL;
1070 Lisp_Object selection = Qnil;
1071 FRAME_PTR f = NULL;
1072 Lisp_Object x, y, window;
1073 int keymaps = 0;
1074 int for_click = 0;
1075 int specpdl_count = SPECPDL_INDEX ();
1076 Lisp_Object timestamp = Qnil;
1077 struct gcpro gcpro1;
1079 if (NILP (position))
1080 /* This is an obsolete call, which wants us to precompute the
1081 keybinding equivalents, but we don't do that any more anyway. */
1082 return Qnil;
1084 #ifdef HAVE_MENUS
1086 int get_current_pos_p = 0;
1087 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1089 /* Decode the first argument: find the window and the coordinates. */
1090 if (EQ (position, Qt)
1091 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1092 || EQ (XCAR (position), Qtool_bar))))
1094 get_current_pos_p = 1;
1096 else
1098 tem = Fcar (position);
1099 if (CONSP (tem))
1101 window = Fcar (Fcdr (position));
1102 x = XCAR (tem);
1103 y = Fcar (XCDR (tem));
1105 else
1107 for_click = 1;
1108 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1109 window = Fcar (tem); /* POSN_WINDOW (tem) */
1110 tem = Fcdr (Fcdr (tem));
1111 x = Fcar (Fcar (tem));
1112 y = Fcdr (Fcar (tem));
1113 timestamp = Fcar (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 unsigned long time;
1147 void (*mouse_position_hook) P_ ((struct frame **, int,
1148 Lisp_Object *,
1149 enum scroll_bar_part *,
1150 Lisp_Object *,
1151 Lisp_Object *,
1152 unsigned long *)) =
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 CHECK_NUMBER (x);
1171 CHECK_NUMBER (y);
1173 /* Decode where to put the menu. */
1175 if (FRAMEP (window))
1177 f = XFRAME (window);
1178 xpos = 0;
1179 ypos = 0;
1181 else if (WINDOWP (window))
1183 struct window *win = XWINDOW (window);
1184 CHECK_LIVE_WINDOW (window);
1185 f = XFRAME (WINDOW_FRAME (win));
1187 xpos = WINDOW_LEFT_EDGE_X (win);
1188 ypos = WINDOW_TOP_EDGE_Y (win);
1190 else
1191 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1192 but I don't want to make one now. */
1193 CHECK_WINDOW (window);
1195 xpos += XINT (x);
1196 ypos += XINT (y);
1198 /* FIXME: Find a more general check! */
1199 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1200 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1201 error ("Can not put GUI menu on this terminal");
1203 XSETFRAME (Vmenu_updating_frame, f);
1205 #endif /* HAVE_MENUS */
1207 /* Now parse the lisp menus. */
1208 record_unwind_protect (unuse_menu_items, Qnil);
1210 title = Qnil;
1211 GCPRO1 (title);
1213 /* Decode the menu items from what was specified. */
1215 keymap = get_keymap (menu, 0, 0);
1216 if (CONSP (keymap))
1218 /* We were given a keymap. Extract menu info from the keymap. */
1219 Lisp_Object prompt;
1221 /* Extract the detailed info to make one pane. */
1222 keymap_panes (&menu, 1);
1224 /* Search for a string appearing directly as an element of the keymap.
1225 That string is the title of the menu. */
1226 prompt = Fkeymap_prompt (keymap);
1227 if (!NILP (prompt))
1228 title = prompt;
1229 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1230 else
1231 title = build_string ("Select");
1232 #endif
1234 /* Make that be the pane title of the first pane. */
1235 if (!NILP (prompt) && menu_items_n_panes >= 0)
1236 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1238 keymaps = 1;
1240 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1242 /* We were given a list of keymaps. */
1243 int nmaps = XFASTINT (Flength (menu));
1244 Lisp_Object *maps
1245 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1246 int i;
1248 title = Qnil;
1250 /* The first keymap that has a prompt string
1251 supplies the menu title. */
1252 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1254 Lisp_Object prompt;
1256 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1258 prompt = Fkeymap_prompt (keymap);
1259 if (NILP (title) && !NILP (prompt))
1260 title = prompt;
1263 /* Extract the detailed info to make one pane. */
1264 keymap_panes (maps, nmaps);
1266 /* Make the title be the pane title of the first pane. */
1267 if (!NILP (title) && menu_items_n_panes >= 0)
1268 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1270 keymaps = 1;
1272 else
1274 /* We were given an old-fashioned menu. */
1275 title = Fcar (menu);
1276 CHECK_STRING (title);
1278 list_of_panes (Fcdr (menu));
1280 keymaps = 0;
1283 unbind_to (specpdl_count, Qnil);
1285 #ifdef HAVE_MENUS
1286 #ifdef HAVE_WINDOW_SYSTEM
1287 /* Hide a previous tip, if any. */
1288 Fx_hide_tip ();
1289 #endif
1291 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1292 /* If resources from a previous popup menu still exist, does nothing
1293 until the `menu_free_timer' has freed them (see w32fns.c). This
1294 can occur if you press ESC or click outside a menu without selecting
1295 a menu item.
1297 if (current_popup_menu)
1299 discard_menu_items ();
1300 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1301 UNGCPRO;
1302 return Qnil;
1304 #endif
1306 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1307 record_unwind_protect (cleanup_popup_menu, Qnil);
1308 #endif
1310 /* Display them in a menu. */
1311 BLOCK_INPUT;
1313 /* FIXME: Use a terminal hook! */
1314 #if defined HAVE_NTGUI
1315 selection = w32_menu_show (f, xpos, ypos, for_click,
1316 keymaps, title, &error_name);
1317 #elif defined HAVE_NS
1318 selection = ns_menu_show (f, xpos, ypos, for_click,
1319 keymaps, title, &error_name);
1320 #else /* MSDOS and X11 */
1321 selection = xmenu_show (f, xpos, ypos, for_click,
1322 keymaps, title, &error_name,
1323 INTEGERP (timestamp) ? XUINT (timestamp) : 0);
1324 #endif
1326 UNBLOCK_INPUT;
1328 #ifdef HAVE_NS
1329 unbind_to (specpdl_count, Qnil);
1330 #else
1331 discard_menu_items ();
1332 #endif
1334 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1335 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1336 #endif
1338 #endif /* HAVE_MENUS */
1340 UNGCPRO;
1342 if (error_name) error (error_name);
1343 return selection;
1346 void
1347 syms_of_menu ()
1349 staticpro (&menu_items);
1350 menu_items = Qnil;
1351 menu_items_inuse = Qnil;
1353 defsubr (&Sx_popup_menu);
1356 /* arch-tag: 78bbc7cf-8025-4156-aa8a-6c7fd99bf51d
1357 (do not change this comment) */