Fix up "missing braces" warning.
[emacs.git] / src / menu.c
bloba424200fb3e5d98c4e6fd62b5b735fb534a50334
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 /* The timestamp of the last input event Emacs received from the X server. */
65 /* Defined in keyboard.c. */
66 extern unsigned long last_event_timestamp;
68 extern Lisp_Object QCtoggle, QCradio;
70 Lisp_Object menu_items;
72 /* If non-nil, means that the global vars defined here are already in use.
73 Used to detect cases where we try to re-enter this non-reentrant code. */
74 Lisp_Object menu_items_inuse;
76 /* Number of slots currently allocated in menu_items. */
77 int menu_items_allocated;
79 /* This is the index in menu_items of the first empty slot. */
80 int menu_items_used;
82 /* The number of panes currently recorded in menu_items,
83 excluding those within submenus. */
84 int menu_items_n_panes;
86 /* Current depth within submenus. */
87 static int menu_items_submenu_depth;
89 void
90 init_menu_items (void)
92 if (!NILP (menu_items_inuse))
93 error ("Trying to use a menu from within a menu-entry");
95 if (NILP (menu_items))
97 menu_items_allocated = 60;
98 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
101 menu_items_inuse = Qt;
102 menu_items_used = 0;
103 menu_items_n_panes = 0;
104 menu_items_submenu_depth = 0;
107 /* Call at the end of generating the data in menu_items. */
109 void
110 finish_menu_items (void)
114 Lisp_Object
115 unuse_menu_items (Lisp_Object dummy)
117 return menu_items_inuse = Qnil;
120 /* Call when finished using the data for the current menu
121 in menu_items. */
123 void
124 discard_menu_items (void)
126 /* Free the structure if it is especially large.
127 Otherwise, hold on to it, to save time. */
128 if (menu_items_allocated > 200)
130 menu_items = Qnil;
131 menu_items_allocated = 0;
133 xassert (NILP (menu_items_inuse));
136 static Lisp_Object
137 cleanup_popup_menu (Lisp_Object arg)
139 discard_menu_items ();
140 return Qnil;
143 /* This undoes save_menu_items, and it is called by the specpdl unwind
144 mechanism. */
146 static Lisp_Object
147 restore_menu_items (Lisp_Object saved)
149 menu_items = XCAR (saved);
150 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
151 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
152 saved = XCDR (saved);
153 menu_items_used = XINT (XCAR (saved));
154 saved = XCDR (saved);
155 menu_items_n_panes = XINT (XCAR (saved));
156 saved = XCDR (saved);
157 menu_items_submenu_depth = XINT (XCAR (saved));
158 return Qnil;
161 /* Push the whole state of menu_items processing onto the specpdl.
162 It will be restored when the specpdl is unwound. */
164 void
165 save_menu_items (void)
167 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
168 make_number (menu_items_used),
169 make_number (menu_items_n_panes),
170 make_number (menu_items_submenu_depth));
171 record_unwind_protect (restore_menu_items, saved);
172 menu_items_inuse = Qnil;
173 menu_items = Qnil;
177 /* Make the menu_items vector twice as large. */
179 static void
180 grow_menu_items (void)
182 menu_items_allocated *= 2;
183 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
186 /* Begin a submenu. */
188 static void
189 push_submenu_start (void)
191 if (menu_items_used + 1 > menu_items_allocated)
192 grow_menu_items ();
194 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
195 menu_items_submenu_depth++;
198 /* End a submenu. */
200 static void
201 push_submenu_end (void)
203 if (menu_items_used + 1 > menu_items_allocated)
204 grow_menu_items ();
206 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
207 menu_items_submenu_depth--;
210 /* Indicate boundary between left and right. */
212 static void
213 push_left_right_boundary (void)
215 if (menu_items_used + 1 > menu_items_allocated)
216 grow_menu_items ();
218 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
221 /* Start a new menu pane in menu_items.
222 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
224 static void
225 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
227 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
228 grow_menu_items ();
230 if (menu_items_submenu_depth == 0)
231 menu_items_n_panes++;
232 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
233 XVECTOR (menu_items)->contents[menu_items_used++] = name;
234 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
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 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 (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 (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
333 Lisp_Object map, item_string, enabled;
334 struct gcpro gcpro1, gcpro2;
335 int res;
336 struct skp *skp = skp_v;
338 /* Parse the menu item and leave the result in item_properties. */
339 GCPRO2 (key, item);
340 res = parse_menu_item (item, 0);
341 UNGCPRO;
342 if (!res)
343 return; /* Not a menu item. */
345 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
347 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
348 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
350 if (!NILP (map) && SREF (item_string, 0) == '@')
352 if (!NILP (enabled))
353 /* An enabled separate pane. Remember this to handle it later. */
354 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
355 skp->pending_maps);
356 return;
359 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
360 #ifndef HAVE_BOXES
361 /* Simulate radio buttons and toggle boxes by putting a prefix in
362 front of them. */
364 Lisp_Object prefix = Qnil;
365 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
366 if (!NILP (type))
368 Lisp_Object selected
369 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
371 if (skp->notbuttons)
372 /* The first button. Line up previous items in this menu. */
374 int index = skp->notbuttons; /* Index for first item this menu. */
375 int submenu = 0;
376 Lisp_Object tem;
377 while (index < menu_items_used)
380 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
381 if (NILP (tem))
383 index++;
384 submenu++; /* Skip sub menu. */
386 else if (EQ (tem, Qlambda))
388 index++;
389 submenu--; /* End sub menu. */
391 else if (EQ (tem, Qt))
392 index += 3; /* Skip new pane marker. */
393 else if (EQ (tem, Qquote))
394 index++; /* Skip a left, right divider. */
395 else
397 if (!submenu && SREF (tem, 0) != '\0'
398 && SREF (tem, 0) != '-')
399 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
400 = concat2 (build_string (" "), tem);
401 index += MENU_ITEMS_ITEM_LENGTH;
404 skp->notbuttons = 0;
407 /* Calculate prefix, if any, for this item. */
408 if (EQ (type, QCtoggle))
409 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
410 else if (EQ (type, QCradio))
411 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
413 /* Not a button. If we have earlier buttons, then we need a prefix. */
414 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
415 && SREF (item_string, 0) != '-')
416 prefix = build_string (" ");
418 if (!NILP (prefix))
419 item_string = concat2 (prefix, item_string);
421 #endif /* not HAVE_BOXES */
423 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
424 if (!NILP (map))
425 /* Indicate visually that this is a submenu. */
426 item_string = concat2 (item_string, build_string (" >"));
427 #endif
429 #endif /* HAVE_X_WINDOWS || MSDOS */
431 push_menu_item (item_string, enabled, key,
432 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
433 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
434 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
435 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
436 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
438 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
439 /* Display a submenu using the toolkit. */
440 if (! (NILP (map) || NILP (enabled)))
442 push_submenu_start ();
443 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
444 push_submenu_end ();
446 #endif
449 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
450 and generate menu panes for them in menu_items. */
452 static void
453 keymap_panes (Lisp_Object *keymaps, int nmaps)
455 int mapno;
457 init_menu_items ();
459 /* Loop over the given keymaps, making a pane for each map.
460 But don't make a pane that is empty--ignore that map instead.
461 P is the number of panes we have made so far. */
462 for (mapno = 0; mapno < nmaps; mapno++)
463 single_keymap_panes (keymaps[mapno],
464 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
466 finish_menu_items ();
470 /* Push the items in a single pane defined by the alist PANE. */
471 static void
472 list_of_items (Lisp_Object pane)
474 Lisp_Object tail, item, item1;
476 for (tail = pane; CONSP (tail); tail = XCDR (tail))
478 item = XCAR (tail);
479 if (STRINGP (item))
480 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
481 Qnil, Qnil, Qnil, Qnil);
482 else if (CONSP (item))
484 item1 = XCAR (item);
485 CHECK_STRING (item1);
486 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
487 Qt, Qnil, Qnil, Qnil, Qnil);
489 else
490 push_left_right_boundary ();
495 /* Push all the panes and items of a menu described by the
496 alist-of-alists MENU.
497 This handles old-fashioned calls to x-popup-menu. */
498 void
499 list_of_panes (Lisp_Object menu)
501 Lisp_Object tail;
503 init_menu_items ();
505 for (tail = menu; CONSP (tail); tail = XCDR (tail))
507 Lisp_Object elt, pane_name, pane_data;
508 elt = XCAR (tail);
509 pane_name = Fcar (elt);
510 CHECK_STRING (pane_name);
511 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
512 pane_data = Fcdr (elt);
513 CHECK_CONS (pane_data);
514 list_of_items (pane_data);
517 finish_menu_items ();
520 /* Set up data in menu_items for a menu bar item
521 whose event type is ITEM_KEY (with string ITEM_NAME)
522 and whose contents come from the list of keymaps MAPS. */
524 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
526 Lisp_Object length;
527 int len;
528 Lisp_Object *mapvec;
529 int i;
530 int top_level_items = 0;
532 length = Flength (maps);
533 len = XINT (length);
535 /* Convert the list MAPS into a vector MAPVEC. */
536 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
537 for (i = 0; i < len; i++)
539 mapvec[i] = Fcar (maps);
540 maps = Fcdr (maps);
543 /* Loop over the given keymaps, making a pane for each map.
544 But don't make a pane that is empty--ignore that map instead. */
545 for (i = 0; i < len; i++)
547 if (!KEYMAPP (mapvec[i]))
549 /* Here we have a command at top level in the menu bar
550 as opposed to a submenu. */
551 top_level_items = 1;
552 push_menu_pane (Qnil, Qnil);
553 push_menu_item (item_name, Qt, item_key, mapvec[i],
554 Qnil, Qnil, Qnil, Qnil);
556 else
558 Lisp_Object prompt;
559 prompt = Fkeymap_prompt (mapvec[i]);
560 single_keymap_panes (mapvec[i],
561 !NILP (prompt) ? prompt : item_name,
562 item_key, 10);
566 return top_level_items;
570 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
572 /* Allocate a widget_value, blocking input. */
574 widget_value *
575 xmalloc_widget_value (void)
577 widget_value *value;
579 BLOCK_INPUT;
580 value = malloc_widget_value ();
581 UNBLOCK_INPUT;
583 return value;
586 /* This recursively calls free_widget_value on the tree of widgets.
587 It must free all data that was malloc'ed for these widget_values.
588 In Emacs, many slots are pointers into the data of Lisp_Strings, and
589 must be left alone. */
591 void
592 free_menubar_widget_value_tree (widget_value *wv)
594 if (! wv) return;
596 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
598 if (wv->contents && (wv->contents != (widget_value*)1))
600 free_menubar_widget_value_tree (wv->contents);
601 wv->contents = (widget_value *) 0xDEADBEEF;
603 if (wv->next)
605 free_menubar_widget_value_tree (wv->next);
606 wv->next = (widget_value *) 0xDEADBEEF;
608 BLOCK_INPUT;
609 free_widget_value (wv);
610 UNBLOCK_INPUT;
613 /* Create a tree of widget_value objects
614 representing the panes and items
615 in menu_items starting at index START, up to index END. */
617 widget_value *
618 digest_single_submenu (int start, int end, int top_level_items)
620 widget_value *wv, *prev_wv, *save_wv, *first_wv;
621 int i;
622 int submenu_depth = 0;
623 widget_value **submenu_stack;
624 int panes_seen = 0;
626 submenu_stack
627 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
628 wv = xmalloc_widget_value ();
629 wv->name = "menu";
630 wv->value = 0;
631 wv->enabled = 1;
632 wv->button_type = BUTTON_TYPE_NONE;
633 wv->help = Qnil;
634 first_wv = wv;
635 save_wv = 0;
636 prev_wv = 0;
638 /* Loop over all panes and items made by the preceding call
639 to parse_single_submenu and construct a tree of widget_value objects.
640 Ignore the panes and items used by previous calls to
641 digest_single_submenu, even though those are also in menu_items. */
642 i = start;
643 while (i < end)
645 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
647 submenu_stack[submenu_depth++] = save_wv;
648 save_wv = prev_wv;
649 prev_wv = 0;
650 i++;
652 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
654 prev_wv = save_wv;
655 save_wv = submenu_stack[--submenu_depth];
656 i++;
658 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
659 && submenu_depth != 0)
660 i += MENU_ITEMS_PANE_LENGTH;
661 /* Ignore a nil in the item list.
662 It's meaningful only for dialog boxes. */
663 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
664 i += 1;
665 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
667 /* Create a new pane. */
668 Lisp_Object pane_name, prefix;
669 char *pane_string;
671 panes_seen++;
673 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
674 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
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 ? "" : (char *) SDATA (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 == 0)
740 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 EMACS_INT 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 *) (EMACS_INT) 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 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 = (char *) SDATA (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 = (char *) SDATA (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 = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
889 prefix = Qnil;
890 i = 0;
892 while (i < menu_bar_items_used)
894 if (EQ (XVECTOR (vector)->contents[i], Qnil))
896 subprefix_stack[submenu_depth++] = prefix;
897 prefix = entry;
898 i++;
900 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
902 prefix = subprefix_stack[--submenu_depth];
903 i++;
905 else if (EQ (XVECTOR (vector)->contents[i], Qt))
907 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
908 i += MENU_ITEMS_PANE_LENGTH;
910 else
912 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
913 /* The EMACS_INT cast avoids a warning. There's no problem
914 as long as pointers have enough bits to hold small integers. */
915 if ((int) (EMACS_INT) 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==1, return full prefixes to selection. */
962 Lisp_Object
963 find_and_return_menu_selection (FRAME_PTR f, int 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 =
973 (Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
975 while (i < menu_items_used)
977 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
979 subprefix_stack[submenu_depth++] = prefix;
980 prefix = entry;
981 i++;
983 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
985 prefix = subprefix_stack[--submenu_depth];
986 i++;
988 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
990 prefix
991 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
992 i += MENU_ITEMS_PANE_LENGTH;
994 /* Ignore a nil in the item list.
995 It's meaningful only for dialog boxes. */
996 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
997 i += 1;
998 else
1000 entry
1001 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1002 if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
1004 if (keymaps != 0)
1006 int j;
1008 entry = Fcons (entry, Qnil);
1009 if (!NILP (prefix))
1010 entry = Fcons (prefix, entry);
1011 for (j = submenu_depth - 1; j >= 0; j--)
1012 if (!NILP (subprefix_stack[j]))
1013 entry = Fcons (subprefix_stack[j], entry);
1015 return entry;
1017 i += MENU_ITEMS_ITEM_LENGTH;
1020 return Qnil;
1022 #endif /* HAVE_NS */
1024 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1025 doc: /* Pop up a deck-of-cards menu and return user's selection.
1026 POSITION is a position specification. This is either a mouse button event
1027 or a list ((XOFFSET YOFFSET) WINDOW)
1028 where XOFFSET and YOFFSET are positions in pixels from the top left
1029 corner of WINDOW. (WINDOW may be a window or a frame object.)
1030 This controls the position of the top left of the menu as a whole.
1031 If POSITION is t, it means to use the current mouse position.
1033 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1034 The menu items come from key bindings that have a menu string as well as
1035 a definition; actually, the "definition" in such a key binding looks like
1036 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1037 the keymap as a top-level element.
1039 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1040 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1042 You can also use a list of keymaps as MENU.
1043 Then each keymap makes a separate pane.
1045 When MENU is a keymap or a list of keymaps, the return value is the
1046 list of events corresponding to the user's choice. Note that
1047 `x-popup-menu' does not actually execute the command bound to that
1048 sequence of events.
1050 Alternatively, you can specify a menu of multiple panes
1051 with a list of the form (TITLE PANE1 PANE2...),
1052 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1053 Each ITEM is normally a cons cell (STRING . VALUE);
1054 but a string can appear as an item--that makes a nonselectable line
1055 in the menu.
1056 With this form of menu, the return value is VALUE from the chosen item.
1058 If POSITION is nil, don't display the menu at all, just precalculate the
1059 cached information about equivalent key sequences.
1061 If the user gets rid of the menu without making a valid choice, for
1062 instance by clicking the mouse away from a valid choice or by typing
1063 keyboard input, then this normally results in a quit and
1064 `x-popup-menu' does not return. But if POSITION is a mouse button
1065 event (indicating that the user invoked the menu with the mouse) then
1066 no quit occurs and `x-popup-menu' returns nil. */)
1067 (Lisp_Object position, Lisp_Object menu)
1069 Lisp_Object keymap, tem;
1070 int xpos = 0, ypos = 0;
1071 Lisp_Object title;
1072 char *error_name = NULL;
1073 Lisp_Object selection = Qnil;
1074 FRAME_PTR f = NULL;
1075 Lisp_Object x, y, window;
1076 int keymaps = 0;
1077 int for_click = 0;
1078 int specpdl_count = SPECPDL_INDEX ();
1079 struct gcpro gcpro1;
1081 if (NILP (position))
1082 /* This is an obsolete call, which wants us to precompute the
1083 keybinding equivalents, but we don't do that any more anyway. */
1084 return Qnil;
1086 #ifdef HAVE_MENUS
1088 int get_current_pos_p = 0;
1089 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1091 /* Decode the first argument: find the window and the coordinates. */
1092 if (EQ (position, Qt)
1093 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1094 || EQ (XCAR (position), Qtool_bar))))
1096 get_current_pos_p = 1;
1098 else
1100 tem = Fcar (position);
1101 if (CONSP (tem))
1103 window = Fcar (Fcdr (position));
1104 x = XCAR (tem);
1105 y = Fcar (XCDR (tem));
1107 else
1109 for_click = 1;
1110 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1111 window = Fcar (tem); /* POSN_WINDOW (tem) */
1112 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1113 x = Fcar (tem);
1114 y = Fcdr (tem);
1117 /* If a click happens in an external tool bar or a detached
1118 tool bar, x and y is NIL. In that case, use the current
1119 mouse position. This happens for the help button in the
1120 tool bar. Ideally popup-menu should pass NIL to
1121 this function, but it doesn't. */
1122 if (NILP (x) && NILP (y))
1123 get_current_pos_p = 1;
1126 if (get_current_pos_p)
1128 /* Use the mouse's current position. */
1129 FRAME_PTR new_f = SELECTED_FRAME ();
1130 #ifdef HAVE_X_WINDOWS
1131 /* Can't use mouse_position_hook for X since it returns
1132 coordinates relative to the window the mouse is in,
1133 we need coordinates relative to the edit widget always. */
1134 if (new_f != 0)
1136 int cur_x, cur_y;
1138 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1139 /* cur_x/y may be negative, so use make_number. */
1140 x = make_number (cur_x);
1141 y = make_number (cur_y);
1144 #else /* not HAVE_X_WINDOWS */
1145 Lisp_Object bar_window;
1146 enum scroll_bar_part part;
1147 unsigned long time;
1148 void (*mouse_position_hook) (struct frame **, int,
1149 Lisp_Object *,
1150 enum scroll_bar_part *,
1151 Lisp_Object *,
1152 Lisp_Object *,
1153 unsigned long *) =
1154 FRAME_TERMINAL (new_f)->mouse_position_hook;
1156 if (mouse_position_hook)
1157 (*mouse_position_hook) (&new_f, 1, &bar_window,
1158 &part, &x, &y, &time);
1159 #endif /* not HAVE_X_WINDOWS */
1161 if (new_f != 0)
1162 XSETFRAME (window, new_f);
1163 else
1165 window = selected_window;
1166 XSETFASTINT (x, 0);
1167 XSETFASTINT (y, 0);
1171 CHECK_NUMBER (x);
1172 CHECK_NUMBER (y);
1174 /* Decode where to put the menu. */
1176 if (FRAMEP (window))
1178 f = XFRAME (window);
1179 xpos = 0;
1180 ypos = 0;
1182 else if (WINDOWP (window))
1184 struct window *win = XWINDOW (window);
1185 CHECK_LIVE_WINDOW (window);
1186 f = XFRAME (WINDOW_FRAME (win));
1188 xpos = WINDOW_LEFT_EDGE_X (win);
1189 ypos = WINDOW_TOP_EDGE_Y (win);
1191 else
1192 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1193 but I don't want to make one now. */
1194 CHECK_WINDOW (window);
1196 xpos += XINT (x);
1197 ypos += XINT (y);
1199 /* FIXME: Find a more general check! */
1200 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1201 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1202 error ("Can not put GUI menu on this terminal");
1204 XSETFRAME (Vmenu_updating_frame, f);
1206 #endif /* HAVE_MENUS */
1208 /* Now parse the lisp menus. */
1209 record_unwind_protect (unuse_menu_items, Qnil);
1211 title = Qnil;
1212 GCPRO1 (title);
1214 /* Decode the menu items from what was specified. */
1216 keymap = get_keymap (menu, 0, 0);
1217 if (CONSP (keymap))
1219 /* We were given a keymap. Extract menu info from the keymap. */
1220 Lisp_Object prompt;
1222 /* Extract the detailed info to make one pane. */
1223 keymap_panes (&menu, 1);
1225 /* Search for a string appearing directly as an element of the keymap.
1226 That string is the title of the menu. */
1227 prompt = Fkeymap_prompt (keymap);
1228 if (!NILP (prompt))
1229 title = prompt;
1230 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1231 else
1232 title = build_string ("Select");
1233 #endif
1235 /* Make that be the pane title of the first pane. */
1236 if (!NILP (prompt) && menu_items_n_panes >= 0)
1237 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1239 keymaps = 1;
1241 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1243 /* We were given a list of keymaps. */
1244 int nmaps = XFASTINT (Flength (menu));
1245 Lisp_Object *maps
1246 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1247 int i;
1249 title = Qnil;
1251 /* The first keymap that has a prompt string
1252 supplies the menu title. */
1253 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1255 Lisp_Object prompt;
1257 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1259 prompt = Fkeymap_prompt (keymap);
1260 if (NILP (title) && !NILP (prompt))
1261 title = prompt;
1264 /* Extract the detailed info to make one pane. */
1265 keymap_panes (maps, nmaps);
1267 /* Make the title be the pane title of the first pane. */
1268 if (!NILP (title) && menu_items_n_panes >= 0)
1269 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1271 keymaps = 1;
1273 else
1275 /* We were given an old-fashioned menu. */
1276 title = Fcar (menu);
1277 CHECK_STRING (title);
1279 list_of_panes (Fcdr (menu));
1281 keymaps = 0;
1284 unbind_to (specpdl_count, Qnil);
1286 #ifdef HAVE_MENUS
1287 #ifdef HAVE_WINDOW_SYSTEM
1288 /* Hide a previous tip, if any. */
1289 Fx_hide_tip ();
1290 #endif
1292 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1293 /* If resources from a previous popup menu still exist, does nothing
1294 until the `menu_free_timer' has freed them (see w32fns.c). This
1295 can occur if you press ESC or click outside a menu without selecting
1296 a menu item.
1298 if (current_popup_menu)
1300 discard_menu_items ();
1301 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1302 UNGCPRO;
1303 return Qnil;
1305 #endif
1307 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1308 record_unwind_protect (cleanup_popup_menu, Qnil);
1309 #endif
1311 /* Display them in a menu. */
1312 BLOCK_INPUT;
1314 /* FIXME: Use a terminal hook! */
1315 #if defined HAVE_NTGUI
1316 selection = w32_menu_show (f, xpos, ypos, for_click,
1317 keymaps, title, &error_name);
1318 #elif defined HAVE_NS
1319 selection = ns_menu_show (f, xpos, ypos, for_click,
1320 keymaps, title, &error_name);
1321 #else /* MSDOS and X11 */
1322 /* Assume last_event_timestamp is the timestamp of the button event.
1323 Is this assumption ever violated? We can't use the timestamp
1324 stored within POSITION because there the top bits from the actual
1325 timestamp may be truncated away (Bug#4930). */
1326 selection = xmenu_show (f, xpos, ypos, for_click,
1327 keymaps, title, &error_name,
1328 last_event_timestamp);
1329 #endif
1331 UNBLOCK_INPUT;
1333 #ifdef HAVE_NS
1334 unbind_to (specpdl_count, Qnil);
1335 #else
1336 discard_menu_items ();
1337 #endif
1339 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1340 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1341 #endif
1343 #endif /* HAVE_MENUS */
1345 UNGCPRO;
1347 if (error_name) error (error_name);
1348 return selection;
1351 void
1352 syms_of_menu (void)
1354 staticpro (&menu_items);
1355 menu_items = Qnil;
1356 menu_items_inuse = Qnil;
1358 defsubr (&Sx_popup_menu);
1361 /* arch-tag: 78bbc7cf-8025-4156-aa8a-6c7fd99bf51d
1362 (do not change this comment) */