lisp/textmodes/bibtex.el: new command bibtex-search-entries
[emacs.git] / src / menu.c
blob7eda4c6ebb5aad78ba4ce108d9818a9f08708a28
1 /* Platform-independent code for terminal communications.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2011
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 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 (void)
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 (void)
110 Lisp_Object
111 unuse_menu_items (Lisp_Object dummy)
113 return menu_items_inuse = Qnil;
116 /* Call when finished using the data for the current menu
117 in menu_items. */
119 void
120 discard_menu_items (void)
122 /* Free the structure if it is especially large.
123 Otherwise, hold on to it, to save time. */
124 if (menu_items_allocated > 200)
126 menu_items = Qnil;
127 menu_items_allocated = 0;
129 xassert (NILP (menu_items_inuse));
132 #ifdef HAVE_NS
133 static Lisp_Object
134 cleanup_popup_menu (Lisp_Object arg)
136 discard_menu_items ();
137 return Qnil;
139 #endif
141 /* This undoes save_menu_items, and it is called by the specpdl unwind
142 mechanism. */
144 static Lisp_Object
145 restore_menu_items (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 (void)
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 (void)
180 if ((INT_MAX - MENU_ITEMS_PANE_LENGTH) / 2 < menu_items_allocated)
181 memory_full (SIZE_MAX);
182 menu_items_allocated *= 2;
183 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
186 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
187 || defined HAVE_NTGUI)
189 /* Begin a submenu. */
191 static void
192 push_submenu_start (void)
194 if (menu_items_used + 1 > menu_items_allocated)
195 grow_menu_items ();
197 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
198 menu_items_submenu_depth++;
201 /* End a submenu. */
203 static void
204 push_submenu_end (void)
206 if (menu_items_used + 1 > menu_items_allocated)
207 grow_menu_items ();
209 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
210 menu_items_submenu_depth--;
213 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
215 /* Indicate boundary between left and right. */
217 static void
218 push_left_right_boundary (void)
220 if (menu_items_used + 1 > menu_items_allocated)
221 grow_menu_items ();
223 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
226 /* Start a new menu pane in menu_items.
227 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
229 static void
230 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
232 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
233 grow_menu_items ();
235 if (menu_items_submenu_depth == 0)
236 menu_items_n_panes++;
237 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
238 XVECTOR (menu_items)->contents[menu_items_used++] = name;
239 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
242 /* Push one menu item into the current pane. NAME is the string to
243 display. ENABLE if non-nil means this item can be selected. KEY
244 is the key generated by choosing this item, or nil if this item
245 doesn't really have a definition. DEF is the definition of this
246 item. EQUIV is the textual description of the keyboard equivalent
247 for this item (or nil if none). TYPE is the type of this menu
248 item, one of nil, `toggle' or `radio'. */
250 static void
251 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)
253 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
254 grow_menu_items ();
256 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
257 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
258 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
259 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
260 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
261 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
262 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
263 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
265 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
268 /* Args passed between single_keymap_panes and single_menu_item. */
269 struct skp
271 Lisp_Object pending_maps;
272 int maxdepth;
273 int notbuttons;
276 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
277 void *);
279 /* This is a recursive subroutine of keymap_panes.
280 It handles one keymap, KEYMAP.
281 The other arguments are passed along
282 or point to local variables of the previous function.
284 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
286 static void
287 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
288 Lisp_Object prefix, int maxdepth)
290 struct skp skp;
291 struct gcpro gcpro1;
293 skp.pending_maps = Qnil;
294 skp.maxdepth = maxdepth;
295 skp.notbuttons = 0;
297 if (maxdepth <= 0)
298 return;
300 push_menu_pane (pane_name, prefix);
302 #ifndef HAVE_BOXES
303 /* Remember index for first item in this pane so we can go back and
304 add a prefix when (if) we see the first button. After that, notbuttons
305 is set to 0, to mark that we have seen a button and all non button
306 items need a prefix. */
307 skp.notbuttons = menu_items_used;
308 #endif
310 GCPRO1 (skp.pending_maps);
311 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
312 UNGCPRO;
314 /* Process now any submenus which want to be panes at this level. */
315 while (CONSP (skp.pending_maps))
317 Lisp_Object elt, eltcdr, string;
318 elt = XCAR (skp.pending_maps);
319 eltcdr = XCDR (elt);
320 string = XCAR (eltcdr);
321 /* We no longer discard the @ from the beginning of the string here.
322 Instead, we do this in *menu_show. */
323 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
324 skp.pending_maps = XCDR (skp.pending_maps);
328 /* This is a subroutine of single_keymap_panes that handles one
329 keymap entry.
330 KEY is a key in a keymap and ITEM is its binding.
331 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
332 separate panes.
333 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
335 static void
336 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
338 Lisp_Object map, item_string, enabled;
339 struct gcpro gcpro1, gcpro2;
340 int res;
341 struct skp *skp = skp_v;
343 /* Parse the menu item and leave the result in item_properties. */
344 GCPRO2 (key, item);
345 res = parse_menu_item (item, 0);
346 UNGCPRO;
347 if (!res)
348 return; /* Not a menu item. */
350 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
352 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
353 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
355 if (!NILP (map) && SREF (item_string, 0) == '@')
357 if (!NILP (enabled))
358 /* An enabled separate pane. Remember this to handle it later. */
359 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
360 skp->pending_maps);
361 return;
364 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
365 #ifndef HAVE_BOXES
366 /* Simulate radio buttons and toggle boxes by putting a prefix in
367 front of them. */
369 Lisp_Object prefix = Qnil;
370 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
371 if (!NILP (type))
373 Lisp_Object selected
374 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
376 if (skp->notbuttons)
377 /* The first button. Line up previous items in this menu. */
379 int idx = skp->notbuttons; /* Index for first item this menu. */
380 int submenu = 0;
381 Lisp_Object tem;
382 while (idx < menu_items_used)
385 = XVECTOR (menu_items)->contents[idx + MENU_ITEMS_ITEM_NAME];
386 if (NILP (tem))
388 idx++;
389 submenu++; /* Skip sub menu. */
391 else if (EQ (tem, Qlambda))
393 idx++;
394 submenu--; /* End sub menu. */
396 else if (EQ (tem, Qt))
397 idx += 3; /* Skip new pane marker. */
398 else if (EQ (tem, Qquote))
399 idx++; /* Skip a left, right divider. */
400 else
402 if (!submenu && SREF (tem, 0) != '\0'
403 && SREF (tem, 0) != '-')
404 XVECTOR (menu_items)->contents[idx + MENU_ITEMS_ITEM_NAME]
405 = concat2 (build_string (" "), tem);
406 idx += MENU_ITEMS_ITEM_LENGTH;
409 skp->notbuttons = 0;
412 /* Calculate prefix, if any, for this item. */
413 if (EQ (type, QCtoggle))
414 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
415 else if (EQ (type, QCradio))
416 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
418 /* Not a button. If we have earlier buttons, then we need a prefix. */
419 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
420 && SREF (item_string, 0) != '-')
421 prefix = build_string (" ");
423 if (!NILP (prefix))
424 item_string = concat2 (prefix, item_string);
426 #endif /* not HAVE_BOXES */
428 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
429 if (!NILP (map))
430 /* Indicate visually that this is a submenu. */
431 item_string = concat2 (item_string, build_string (" >"));
432 #endif
434 #endif /* HAVE_X_WINDOWS || MSDOS */
436 push_menu_item (item_string, enabled, key,
437 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
438 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
439 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
440 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
441 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
443 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
444 /* Display a submenu using the toolkit. */
445 if (! (NILP (map) || NILP (enabled)))
447 push_submenu_start ();
448 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
449 push_submenu_end ();
451 #endif
454 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
455 and generate menu panes for them in menu_items. */
457 static void
458 keymap_panes (Lisp_Object *keymaps, int nmaps)
460 int mapno;
462 init_menu_items ();
464 /* Loop over the given keymaps, making a pane for each map.
465 But don't make a pane that is empty--ignore that map instead.
466 P is the number of panes we have made so far. */
467 for (mapno = 0; mapno < nmaps; mapno++)
468 single_keymap_panes (keymaps[mapno],
469 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
471 finish_menu_items ();
475 /* Push the items in a single pane defined by the alist PANE. */
476 static void
477 list_of_items (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 (Lisp_Object menu)
506 Lisp_Object tail;
508 init_menu_items ();
510 for (tail = menu; CONSP (tail); tail = XCDR (tail))
512 Lisp_Object elt, pane_name, pane_data;
513 elt = XCAR (tail);
514 pane_name = Fcar (elt);
515 CHECK_STRING (pane_name);
516 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
517 pane_data = Fcdr (elt);
518 CHECK_CONS (pane_data);
519 list_of_items (pane_data);
522 finish_menu_items ();
525 /* Set up data in menu_items for a menu bar item
526 whose event type is ITEM_KEY (with string ITEM_NAME)
527 and whose contents come from the list of keymaps MAPS. */
529 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
531 Lisp_Object length;
532 int len;
533 Lisp_Object *mapvec;
534 int i;
535 int top_level_items = 0;
537 length = Flength (maps);
538 len = XINT (length);
540 /* Convert the list MAPS into a vector MAPVEC. */
541 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
542 for (i = 0; i < len; i++)
544 mapvec[i] = Fcar (maps);
545 maps = Fcdr (maps);
548 /* Loop over the given keymaps, making a pane for each map.
549 But don't make a pane that is empty--ignore that map instead. */
550 for (i = 0; i < len; i++)
552 if (!KEYMAPP (mapvec[i]))
554 /* Here we have a command at top level in the menu bar
555 as opposed to a submenu. */
556 top_level_items = 1;
557 push_menu_pane (Qnil, Qnil);
558 push_menu_item (item_name, Qt, item_key, mapvec[i],
559 Qnil, Qnil, Qnil, Qnil);
561 else
563 Lisp_Object prompt;
564 prompt = Fkeymap_prompt (mapvec[i]);
565 single_keymap_panes (mapvec[i],
566 !NILP (prompt) ? prompt : item_name,
567 item_key, 10);
571 return top_level_items;
575 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
577 /* Allocate a widget_value, blocking input. */
579 widget_value *
580 xmalloc_widget_value (void)
582 widget_value *value;
584 BLOCK_INPUT;
585 value = malloc_widget_value ();
586 UNBLOCK_INPUT;
588 return value;
591 /* This recursively calls free_widget_value on the tree of widgets.
592 It must free all data that was malloc'ed for these widget_values.
593 In Emacs, many slots are pointers into the data of Lisp_Strings, and
594 must be left alone. */
596 void
597 free_menubar_widget_value_tree (widget_value *wv)
599 if (! wv) return;
601 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
603 if (wv->contents && (wv->contents != (widget_value*)1))
605 free_menubar_widget_value_tree (wv->contents);
606 wv->contents = (widget_value *) 0xDEADBEEF;
608 if (wv->next)
610 free_menubar_widget_value_tree (wv->next);
611 wv->next = (widget_value *) 0xDEADBEEF;
613 BLOCK_INPUT;
614 free_widget_value (wv);
615 UNBLOCK_INPUT;
618 /* Create a tree of widget_value objects
619 representing the panes and items
620 in menu_items starting at index START, up to index END. */
622 widget_value *
623 digest_single_submenu (int start, int end, int top_level_items)
625 widget_value *wv, *prev_wv, *save_wv, *first_wv;
626 int i;
627 int submenu_depth = 0;
628 widget_value **submenu_stack;
629 int panes_seen = 0;
631 submenu_stack
632 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
633 wv = xmalloc_widget_value ();
634 wv->name = "menu";
635 wv->value = 0;
636 wv->enabled = 1;
637 wv->button_type = BUTTON_TYPE_NONE;
638 wv->help = Qnil;
639 first_wv = wv;
640 save_wv = 0;
641 prev_wv = 0;
643 /* Loop over all panes and items made by the preceding call
644 to parse_single_submenu and construct a tree of widget_value objects.
645 Ignore the panes and items used by previous calls to
646 digest_single_submenu, even though those are also in menu_items. */
647 i = start;
648 while (i < end)
650 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
652 submenu_stack[submenu_depth++] = save_wv;
653 save_wv = prev_wv;
654 prev_wv = 0;
655 i++;
657 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
659 prev_wv = save_wv;
660 save_wv = submenu_stack[--submenu_depth];
661 i++;
663 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
664 && submenu_depth != 0)
665 i += MENU_ITEMS_PANE_LENGTH;
666 /* Ignore a nil in the item list.
667 It's meaningful only for dialog boxes. */
668 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
669 i += 1;
670 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
672 /* Create a new pane. */
673 Lisp_Object pane_name;
674 const char *pane_string;
676 panes_seen++;
678 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
680 #ifdef HAVE_NTGUI
681 if (STRINGP (pane_name))
683 if (unicode_append_menu)
684 /* Encode as UTF-8 for now. */
685 pane_name = ENCODE_UTF_8 (pane_name);
686 else if (STRING_MULTIBYTE (pane_name))
687 pane_name = ENCODE_SYSTEM (pane_name);
689 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
691 #elif defined (USE_LUCID) && defined (HAVE_XFT)
692 if (STRINGP (pane_name))
694 pane_name = ENCODE_UTF_8 (pane_name);
695 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
697 #elif !defined (HAVE_MULTILINGUAL_MENU)
698 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
700 pane_name = ENCODE_MENU_STRING (pane_name);
701 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
703 #endif
705 pane_string = (NILP (pane_name)
706 ? "" : SSDATA (pane_name));
707 /* If there is just one top-level pane, put all its items directly
708 under the top-level menu. */
709 if (menu_items_n_panes == 1)
710 pane_string = "";
712 /* If the pane has a meaningful name,
713 make the pane a top-level menu item
714 with its items as a submenu beneath it. */
715 if (strcmp (pane_string, ""))
717 wv = xmalloc_widget_value ();
718 if (save_wv)
719 save_wv->next = wv;
720 else
721 first_wv->contents = wv;
722 wv->lname = pane_name;
723 /* Set value to 1 so update_submenu_strings can handle '@' */
724 wv->value = (char *)1;
725 wv->enabled = 1;
726 wv->button_type = BUTTON_TYPE_NONE;
727 wv->help = Qnil;
728 save_wv = wv;
730 else
731 save_wv = first_wv;
733 prev_wv = 0;
734 i += MENU_ITEMS_PANE_LENGTH;
736 else
738 /* Create a new item within current pane. */
739 Lisp_Object item_name, enable, descrip, def, type, selected;
740 Lisp_Object help;
742 /* All items should be contained in panes. */
743 if (panes_seen == 0)
744 abort ();
746 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
747 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
748 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
749 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
750 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
751 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
752 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
754 #ifdef HAVE_NTGUI
755 if (STRINGP (item_name))
757 if (unicode_append_menu)
758 item_name = ENCODE_UTF_8 (item_name);
759 else if (STRING_MULTIBYTE (item_name))
760 item_name = ENCODE_SYSTEM (item_name);
762 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
765 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
767 descrip = ENCODE_SYSTEM (descrip);
768 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
770 #elif USE_LUCID
771 if (STRINGP (item_name))
773 item_name = ENCODE_UTF_8 (item_name);
774 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
777 if (STRINGP (descrip))
779 descrip = ENCODE_UTF_8 (descrip);
780 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
782 #elif !defined (HAVE_MULTILINGUAL_MENU)
783 if (STRING_MULTIBYTE (item_name))
785 item_name = ENCODE_MENU_STRING (item_name);
786 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
789 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
791 descrip = ENCODE_MENU_STRING (descrip);
792 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
794 #endif
796 wv = xmalloc_widget_value ();
797 if (prev_wv)
798 prev_wv->next = wv;
799 else
800 save_wv->contents = wv;
802 wv->lname = item_name;
803 if (!NILP (descrip))
804 wv->lkey = descrip;
805 wv->value = 0;
806 /* The intptr_t cast avoids a warning. There's no problem
807 as long as pointers have enough bits to hold small integers. */
808 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
809 wv->enabled = !NILP (enable);
811 if (NILP (type))
812 wv->button_type = BUTTON_TYPE_NONE;
813 else if (EQ (type, QCradio))
814 wv->button_type = BUTTON_TYPE_RADIO;
815 else if (EQ (type, QCtoggle))
816 wv->button_type = BUTTON_TYPE_TOGGLE;
817 else
818 abort ();
820 wv->selected = !NILP (selected);
821 if (! STRINGP (help))
822 help = Qnil;
824 wv->help = help;
826 prev_wv = wv;
828 i += MENU_ITEMS_ITEM_LENGTH;
832 /* If we have just one "menu item"
833 that was originally a button, return it by itself. */
834 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
836 wv = first_wv->contents;
837 free_widget_value (first_wv);
838 return wv;
841 return first_wv;
844 /* Walk through the widget_value tree starting at FIRST_WV and update
845 the char * pointers from the corresponding lisp values.
846 We do this after building the whole tree, since GC may happen while the
847 tree is constructed, and small strings are relocated. So we must wait
848 until no GC can happen before storing pointers into lisp values. */
849 void
850 update_submenu_strings (widget_value *first_wv)
852 widget_value *wv;
854 for (wv = first_wv; wv; wv = wv->next)
856 if (STRINGP (wv->lname))
858 wv->name = SSDATA (wv->lname);
860 /* Ignore the @ that means "separate pane".
861 This is a kludge, but this isn't worth more time. */
862 if (wv->value == (char *)1)
864 if (wv->name[0] == '@')
865 wv->name++;
866 wv->value = 0;
870 if (STRINGP (wv->lkey))
871 wv->key = SSDATA (wv->lkey);
873 if (wv->contents)
874 update_submenu_strings (wv->contents);
878 /* Find the menu selection and store it in the keyboard buffer.
879 F is the frame the menu is on.
880 MENU_BAR_ITEMS_USED is the length of VECTOR.
881 VECTOR is an array of menu events for the whole menu. */
883 void
884 find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
886 Lisp_Object prefix, entry;
887 Lisp_Object *subprefix_stack;
888 int submenu_depth = 0;
889 int i;
891 entry = Qnil;
892 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
893 prefix = Qnil;
894 i = 0;
896 while (i < menu_bar_items_used)
898 if (EQ (XVECTOR (vector)->contents[i], Qnil))
900 subprefix_stack[submenu_depth++] = prefix;
901 prefix = entry;
902 i++;
904 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
906 prefix = subprefix_stack[--submenu_depth];
907 i++;
909 else if (EQ (XVECTOR (vector)->contents[i], Qt))
911 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
912 i += MENU_ITEMS_PANE_LENGTH;
914 else
916 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
917 /* Treat the pointer as an integer. There's no problem
918 as long as pointers have enough bits to hold small integers. */
919 if ((intptr_t) client_data == i)
921 int j;
922 struct input_event buf;
923 Lisp_Object frame;
924 EVENT_INIT (buf);
926 XSETFRAME (frame, f);
927 buf.kind = MENU_BAR_EVENT;
928 buf.frame_or_window = frame;
929 buf.arg = frame;
930 kbd_buffer_store_event (&buf);
932 for (j = 0; j < submenu_depth; j++)
933 if (!NILP (subprefix_stack[j]))
935 buf.kind = MENU_BAR_EVENT;
936 buf.frame_or_window = frame;
937 buf.arg = subprefix_stack[j];
938 kbd_buffer_store_event (&buf);
941 if (!NILP (prefix))
943 buf.kind = MENU_BAR_EVENT;
944 buf.frame_or_window = frame;
945 buf.arg = prefix;
946 kbd_buffer_store_event (&buf);
949 buf.kind = MENU_BAR_EVENT;
950 buf.frame_or_window = frame;
951 buf.arg = entry;
952 kbd_buffer_store_event (&buf);
954 return;
956 i += MENU_ITEMS_ITEM_LENGTH;
961 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
963 #ifdef HAVE_NS
964 /* As above, but return the menu selection instead of storing in kb buffer.
965 If keymaps==1, return full prefixes to selection. */
966 Lisp_Object
967 find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
969 Lisp_Object prefix, entry;
970 int i;
971 Lisp_Object *subprefix_stack;
972 int submenu_depth = 0;
974 prefix = entry = Qnil;
975 i = 0;
976 subprefix_stack =
977 (Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
979 while (i < menu_items_used)
981 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
983 subprefix_stack[submenu_depth++] = prefix;
984 prefix = entry;
985 i++;
987 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
989 prefix = subprefix_stack[--submenu_depth];
990 i++;
992 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
994 prefix
995 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
996 i += MENU_ITEMS_PANE_LENGTH;
998 /* Ignore a nil in the item list.
999 It's meaningful only for dialog boxes. */
1000 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1001 i += 1;
1002 else
1004 entry
1005 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1006 if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
1008 if (keymaps != 0)
1010 int j;
1012 entry = Fcons (entry, Qnil);
1013 if (!NILP (prefix))
1014 entry = Fcons (prefix, entry);
1015 for (j = submenu_depth - 1; j >= 0; j--)
1016 if (!NILP (subprefix_stack[j]))
1017 entry = Fcons (subprefix_stack[j], entry);
1019 return entry;
1021 i += MENU_ITEMS_ITEM_LENGTH;
1024 return Qnil;
1026 #endif /* HAVE_NS */
1028 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1029 doc: /* Pop up a deck-of-cards menu and return user's selection.
1030 POSITION is a position specification. This is either a mouse button event
1031 or a list ((XOFFSET YOFFSET) WINDOW)
1032 where XOFFSET and YOFFSET are positions in pixels from the top left
1033 corner of WINDOW. (WINDOW may be a window or a frame object.)
1034 This controls the position of the top left of the menu as a whole.
1035 If POSITION is t, it means to use the current mouse position.
1037 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1038 The menu items come from key bindings that have a menu string as well as
1039 a definition; actually, the "definition" in such a key binding looks like
1040 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1041 the keymap as a top-level element.
1043 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1044 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1046 You can also use a list of keymaps as MENU.
1047 Then each keymap makes a separate pane.
1049 When MENU is a keymap or a list of keymaps, the return value is the
1050 list of events corresponding to the user's choice. Note that
1051 `x-popup-menu' does not actually execute the command bound to that
1052 sequence of events.
1054 Alternatively, you can specify a menu of multiple panes
1055 with a list of the form (TITLE PANE1 PANE2...),
1056 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1057 Each ITEM is normally a cons cell (STRING . VALUE);
1058 but a string can appear as an item--that makes a nonselectable line
1059 in the menu.
1060 With this form of menu, the return value is VALUE from the chosen item.
1062 If POSITION is nil, don't display the menu at all, just precalculate the
1063 cached information about equivalent key sequences.
1065 If the user gets rid of the menu without making a valid choice, for
1066 instance by clicking the mouse away from a valid choice or by typing
1067 keyboard input, then this normally results in a quit and
1068 `x-popup-menu' does not return. But if POSITION is a mouse button
1069 event (indicating that the user invoked the menu with the mouse) then
1070 no quit occurs and `x-popup-menu' returns nil. */)
1071 (Lisp_Object position, Lisp_Object menu)
1073 Lisp_Object keymap, tem;
1074 int xpos = 0, ypos = 0;
1075 Lisp_Object title;
1076 const char *error_name = NULL;
1077 Lisp_Object selection = Qnil;
1078 FRAME_PTR f = NULL;
1079 Lisp_Object x, y, window;
1080 int keymaps = 0;
1081 int for_click = 0;
1082 int specpdl_count = SPECPDL_INDEX ();
1083 struct gcpro gcpro1;
1085 if (NILP (position))
1086 /* This is an obsolete call, which wants us to precompute the
1087 keybinding equivalents, but we don't do that any more anyway. */
1088 return Qnil;
1090 #ifdef HAVE_MENUS
1092 int get_current_pos_p = 0;
1093 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1095 /* Decode the first argument: find the window and the coordinates. */
1096 if (EQ (position, Qt)
1097 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1098 || EQ (XCAR (position), Qtool_bar))))
1100 get_current_pos_p = 1;
1102 else
1104 tem = Fcar (position);
1105 if (CONSP (tem))
1107 window = Fcar (Fcdr (position));
1108 x = XCAR (tem);
1109 y = Fcar (XCDR (tem));
1111 else
1113 for_click = 1;
1114 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1115 window = Fcar (tem); /* POSN_WINDOW (tem) */
1116 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1117 x = Fcar (tem);
1118 y = Fcdr (tem);
1121 /* If a click happens in an external tool bar or a detached
1122 tool bar, x and y is NIL. In that case, use the current
1123 mouse position. This happens for the help button in the
1124 tool bar. Ideally popup-menu should pass NIL to
1125 this function, but it doesn't. */
1126 if (NILP (x) && NILP (y))
1127 get_current_pos_p = 1;
1130 if (get_current_pos_p)
1132 /* Use the mouse's current position. */
1133 FRAME_PTR new_f = SELECTED_FRAME ();
1134 #ifdef HAVE_X_WINDOWS
1135 /* Can't use mouse_position_hook for X since it returns
1136 coordinates relative to the window the mouse is in,
1137 we need coordinates relative to the edit widget always. */
1138 if (new_f != 0)
1140 int cur_x, cur_y;
1142 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1143 /* cur_x/y may be negative, so use make_number. */
1144 x = make_number (cur_x);
1145 y = make_number (cur_y);
1148 #else /* not HAVE_X_WINDOWS */
1149 Lisp_Object bar_window;
1150 enum scroll_bar_part part;
1151 Time time;
1152 void (*mouse_position_hook) (struct frame **, int,
1153 Lisp_Object *,
1154 enum scroll_bar_part *,
1155 Lisp_Object *,
1156 Lisp_Object *,
1157 Time *) =
1158 FRAME_TERMINAL (new_f)->mouse_position_hook;
1160 if (mouse_position_hook)
1161 (*mouse_position_hook) (&new_f, 1, &bar_window,
1162 &part, &x, &y, &time);
1163 #endif /* not HAVE_X_WINDOWS */
1165 if (new_f != 0)
1166 XSETFRAME (window, new_f);
1167 else
1169 window = selected_window;
1170 XSETFASTINT (x, 0);
1171 XSETFASTINT (y, 0);
1175 CHECK_NUMBER (x);
1176 CHECK_NUMBER (y);
1178 /* Decode where to put the menu. */
1180 if (FRAMEP (window))
1182 f = XFRAME (window);
1183 xpos = 0;
1184 ypos = 0;
1186 else if (WINDOWP (window))
1188 struct window *win = XWINDOW (window);
1189 CHECK_LIVE_WINDOW (window);
1190 f = XFRAME (WINDOW_FRAME (win));
1192 xpos = WINDOW_LEFT_EDGE_X (win);
1193 ypos = WINDOW_TOP_EDGE_Y (win);
1195 else
1196 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1197 but I don't want to make one now. */
1198 CHECK_WINDOW (window);
1200 xpos += XINT (x);
1201 ypos += XINT (y);
1203 /* FIXME: Find a more general check! */
1204 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1205 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1206 error ("Can not put GUI menu on this terminal");
1208 XSETFRAME (Vmenu_updating_frame, f);
1210 #endif /* HAVE_MENUS */
1212 /* Now parse the lisp menus. */
1213 record_unwind_protect (unuse_menu_items, Qnil);
1215 title = Qnil;
1216 GCPRO1 (title);
1218 /* Decode the menu items from what was specified. */
1220 keymap = get_keymap (menu, 0, 0);
1221 if (CONSP (keymap))
1223 /* We were given a keymap. Extract menu info from the keymap. */
1224 Lisp_Object prompt;
1226 /* Extract the detailed info to make one pane. */
1227 keymap_panes (&menu, 1);
1229 /* Search for a string appearing directly as an element of the keymap.
1230 That string is the title of the menu. */
1231 prompt = Fkeymap_prompt (keymap);
1232 if (!NILP (prompt))
1233 title = prompt;
1234 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1235 else
1236 title = build_string ("Select");
1237 #endif
1239 /* Make that be the pane title of the first pane. */
1240 if (!NILP (prompt) && menu_items_n_panes >= 0)
1241 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1243 keymaps = 1;
1245 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1247 /* We were given a list of keymaps. */
1248 int nmaps = XFASTINT (Flength (menu));
1249 Lisp_Object *maps
1250 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1251 int i;
1253 title = Qnil;
1255 /* The first keymap that has a prompt string
1256 supplies the menu title. */
1257 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1259 Lisp_Object prompt;
1261 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1263 prompt = Fkeymap_prompt (keymap);
1264 if (NILP (title) && !NILP (prompt))
1265 title = prompt;
1268 /* Extract the detailed info to make one pane. */
1269 keymap_panes (maps, nmaps);
1271 /* Make the title be the pane title of the first pane. */
1272 if (!NILP (title) && menu_items_n_panes >= 0)
1273 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1275 keymaps = 1;
1277 else
1279 /* We were given an old-fashioned menu. */
1280 title = Fcar (menu);
1281 CHECK_STRING (title);
1283 list_of_panes (Fcdr (menu));
1285 keymaps = 0;
1288 unbind_to (specpdl_count, Qnil);
1290 #ifdef HAVE_MENUS
1291 #ifdef HAVE_WINDOW_SYSTEM
1292 /* Hide a previous tip, if any. */
1293 Fx_hide_tip ();
1294 #endif
1296 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1297 /* If resources from a previous popup menu still exist, does nothing
1298 until the `menu_free_timer' has freed them (see w32fns.c). This
1299 can occur if you press ESC or click outside a menu without selecting
1300 a menu item.
1302 if (current_popup_menu)
1304 discard_menu_items ();
1305 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1306 UNGCPRO;
1307 return Qnil;
1309 #endif
1311 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1312 record_unwind_protect (cleanup_popup_menu, Qnil);
1313 #endif
1315 /* Display them in a menu. */
1316 BLOCK_INPUT;
1318 /* FIXME: Use a terminal hook! */
1319 #if defined HAVE_NTGUI
1320 selection = w32_menu_show (f, xpos, ypos, for_click,
1321 keymaps, title, &error_name);
1322 #elif defined HAVE_NS
1323 selection = ns_menu_show (f, xpos, ypos, for_click,
1324 keymaps, title, &error_name);
1325 #else /* MSDOS and X11 */
1326 /* Assume last_event_timestamp is the timestamp of the button event.
1327 Is this assumption ever violated? We can't use the timestamp
1328 stored within POSITION because there the top bits from the actual
1329 timestamp may be truncated away (Bug#4930). */
1330 selection = xmenu_show (f, xpos, ypos, for_click,
1331 keymaps, title, &error_name,
1332 last_event_timestamp);
1333 #endif
1335 UNBLOCK_INPUT;
1337 #ifdef HAVE_NS
1338 unbind_to (specpdl_count, Qnil);
1339 #else
1340 discard_menu_items ();
1341 #endif
1343 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1344 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1345 #endif
1347 #endif /* HAVE_MENUS */
1349 UNGCPRO;
1351 if (error_name) error ("%s", error_name);
1352 return selection;
1355 void
1356 syms_of_menu (void)
1358 staticpro (&menu_items);
1359 menu_items = Qnil;
1360 menu_items_inuse = Qnil;
1362 defsubr (&Sx_popup_menu);