* files.el (directory-files-no-dot-files-regexp): Doc fix (bug#6298).
[emacs.git] / src / menu.c
blobca00c06a98b08bfbe26bb8f4e91e180aa7127e09
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 ()
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 ()
114 Lisp_Object
115 unuse_menu_items (dummy)
116 Lisp_Object dummy;
118 return menu_items_inuse = Qnil;
121 /* Call when finished using the data for the current menu
122 in menu_items. */
124 void
125 discard_menu_items ()
127 /* Free the structure if it is especially large.
128 Otherwise, hold on to it, to save time. */
129 if (menu_items_allocated > 200)
131 menu_items = Qnil;
132 menu_items_allocated = 0;
134 xassert (NILP (menu_items_inuse));
137 static Lisp_Object
138 cleanup_popup_menu (Lisp_Object arg)
140 discard_menu_items ();
141 return Qnil;
144 /* This undoes save_menu_items, and it is called by the specpdl unwind
145 mechanism. */
147 static Lisp_Object
148 restore_menu_items (saved)
149 Lisp_Object saved;
151 menu_items = XCAR (saved);
152 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
153 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
154 saved = XCDR (saved);
155 menu_items_used = XINT (XCAR (saved));
156 saved = XCDR (saved);
157 menu_items_n_panes = XINT (XCAR (saved));
158 saved = XCDR (saved);
159 menu_items_submenu_depth = XINT (XCAR (saved));
160 return Qnil;
163 /* Push the whole state of menu_items processing onto the specpdl.
164 It will be restored when the specpdl is unwound. */
166 void
167 save_menu_items ()
169 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
170 make_number (menu_items_used),
171 make_number (menu_items_n_panes),
172 make_number (menu_items_submenu_depth));
173 record_unwind_protect (restore_menu_items, saved);
174 menu_items_inuse = Qnil;
175 menu_items = Qnil;
179 /* Make the menu_items vector twice as large. */
181 static void
182 grow_menu_items ()
184 menu_items_allocated *= 2;
185 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
188 /* Begin a submenu. */
190 static void
191 push_submenu_start ()
193 if (menu_items_used + 1 > menu_items_allocated)
194 grow_menu_items ();
196 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
197 menu_items_submenu_depth++;
200 /* End a submenu. */
202 static void
203 push_submenu_end ()
205 if (menu_items_used + 1 > menu_items_allocated)
206 grow_menu_items ();
208 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
209 menu_items_submenu_depth--;
212 /* Indicate boundary between left and right. */
214 static void
215 push_left_right_boundary ()
217 if (menu_items_used + 1 > menu_items_allocated)
218 grow_menu_items ();
220 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
223 /* Start a new menu pane in menu_items.
224 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
226 static void
227 push_menu_pane (name, prefix_vec)
228 Lisp_Object name, prefix_vec;
230 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
231 grow_menu_items ();
233 if (menu_items_submenu_depth == 0)
234 menu_items_n_panes++;
235 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
236 XVECTOR (menu_items)->contents[menu_items_used++] = name;
237 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
240 /* Push one menu item into the current pane. NAME is the string to
241 display. ENABLE if non-nil means this item can be selected. KEY
242 is the key generated by choosing this item, or nil if this item
243 doesn't really have a definition. DEF is the definition of this
244 item. EQUIV is the textual description of the keyboard equivalent
245 for this item (or nil if none). TYPE is the type of this menu
246 item, one of nil, `toggle' or `radio'. */
248 static void
249 push_menu_item (name, enable, key, def, equiv, type, selected, help)
250 Lisp_Object name, enable, key, def, equiv, type, selected, help;
252 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
253 grow_menu_items ();
255 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
256 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
257 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
258 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
259 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
260 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
261 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
262 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
264 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
267 /* Args passed between single_keymap_panes and single_menu_item. */
268 struct skp
270 Lisp_Object pending_maps;
271 int maxdepth;
272 int notbuttons;
275 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
276 void *));
278 /* This is a recursive subroutine of keymap_panes.
279 It handles one keymap, KEYMAP.
280 The other arguments are passed along
281 or point to local variables of the previous function.
283 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
285 static void
286 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
287 Lisp_Object prefix, int maxdepth)
289 struct skp skp;
290 struct gcpro gcpro1;
292 skp.pending_maps = Qnil;
293 skp.maxdepth = maxdepth;
294 skp.notbuttons = 0;
296 if (maxdepth <= 0)
297 return;
299 push_menu_pane (pane_name, prefix);
301 #ifndef HAVE_BOXES
302 /* Remember index for first item in this pane so we can go back and
303 add a prefix when (if) we see the first button. After that, notbuttons
304 is set to 0, to mark that we have seen a button and all non button
305 items need a prefix. */
306 skp.notbuttons = menu_items_used;
307 #endif
309 GCPRO1 (skp.pending_maps);
310 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
311 UNGCPRO;
313 /* Process now any submenus which want to be panes at this level. */
314 while (CONSP (skp.pending_maps))
316 Lisp_Object elt, eltcdr, string;
317 elt = XCAR (skp.pending_maps);
318 eltcdr = XCDR (elt);
319 string = XCAR (eltcdr);
320 /* We no longer discard the @ from the beginning of the string here.
321 Instead, we do this in *menu_show. */
322 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
323 skp.pending_maps = XCDR (skp.pending_maps);
327 /* This is a subroutine of single_keymap_panes that handles one
328 keymap entry.
329 KEY is a key in a keymap and ITEM is its binding.
330 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
331 separate panes.
332 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
334 static void
335 single_menu_item (key, item, dummy, skp_v)
336 Lisp_Object key, item, dummy;
337 void *skp_v;
339 Lisp_Object map, item_string, enabled;
340 struct gcpro gcpro1, gcpro2;
341 int res;
342 struct skp *skp = skp_v;
344 /* Parse the menu item and leave the result in item_properties. */
345 GCPRO2 (key, item);
346 res = parse_menu_item (item, 0);
347 UNGCPRO;
348 if (!res)
349 return; /* Not a menu item. */
351 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
353 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
354 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
356 if (!NILP (map) && SREF (item_string, 0) == '@')
358 if (!NILP (enabled))
359 /* An enabled separate pane. Remember this to handle it later. */
360 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
361 skp->pending_maps);
362 return;
365 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
366 #ifndef HAVE_BOXES
367 /* Simulate radio buttons and toggle boxes by putting a prefix in
368 front of them. */
370 Lisp_Object prefix = Qnil;
371 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
372 if (!NILP (type))
374 Lisp_Object selected
375 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
377 if (skp->notbuttons)
378 /* The first button. Line up previous items in this menu. */
380 int index = skp->notbuttons; /* Index for first item this menu. */
381 int submenu = 0;
382 Lisp_Object tem;
383 while (index < menu_items_used)
386 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
387 if (NILP (tem))
389 index++;
390 submenu++; /* Skip sub menu. */
392 else if (EQ (tem, Qlambda))
394 index++;
395 submenu--; /* End sub menu. */
397 else if (EQ (tem, Qt))
398 index += 3; /* Skip new pane marker. */
399 else if (EQ (tem, Qquote))
400 index++; /* Skip a left, right divider. */
401 else
403 if (!submenu && SREF (tem, 0) != '\0'
404 && SREF (tem, 0) != '-')
405 XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
406 = concat2 (build_string (" "), tem);
407 index += MENU_ITEMS_ITEM_LENGTH;
410 skp->notbuttons = 0;
413 /* Calculate prefix, if any, for this item. */
414 if (EQ (type, QCtoggle))
415 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
416 else if (EQ (type, QCradio))
417 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
419 /* Not a button. If we have earlier buttons, then we need a prefix. */
420 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
421 && SREF (item_string, 0) != '-')
422 prefix = build_string (" ");
424 if (!NILP (prefix))
425 item_string = concat2 (prefix, item_string);
427 #endif /* not HAVE_BOXES */
429 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
430 if (!NILP (map))
431 /* Indicate visually that this is a submenu. */
432 item_string = concat2 (item_string, build_string (" >"));
433 #endif
435 #endif /* HAVE_X_WINDOWS || MSDOS */
437 push_menu_item (item_string, enabled, key,
438 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
439 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
440 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
441 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
442 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
444 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
445 /* Display a submenu using the toolkit. */
446 if (! (NILP (map) || NILP (enabled)))
448 push_submenu_start ();
449 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
450 push_submenu_end ();
452 #endif
455 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
456 and generate menu panes for them in menu_items. */
458 static void
459 keymap_panes (keymaps, nmaps)
460 Lisp_Object *keymaps;
461 int nmaps;
463 int mapno;
465 init_menu_items ();
467 /* Loop over the given keymaps, making a pane for each map.
468 But don't make a pane that is empty--ignore that map instead.
469 P is the number of panes we have made so far. */
470 for (mapno = 0; mapno < nmaps; mapno++)
471 single_keymap_panes (keymaps[mapno],
472 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
474 finish_menu_items ();
478 /* Push the items in a single pane defined by the alist PANE. */
479 static void
480 list_of_items (pane)
481 Lisp_Object pane;
483 Lisp_Object tail, item, item1;
485 for (tail = pane; CONSP (tail); tail = XCDR (tail))
487 item = XCAR (tail);
488 if (STRINGP (item))
489 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
490 Qnil, Qnil, Qnil, Qnil);
491 else if (CONSP (item))
493 item1 = XCAR (item);
494 CHECK_STRING (item1);
495 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
496 Qt, Qnil, Qnil, Qnil, Qnil);
498 else
499 push_left_right_boundary ();
504 /* Push all the panes and items of a menu described by the
505 alist-of-alists MENU.
506 This handles old-fashioned calls to x-popup-menu. */
507 void
508 list_of_panes (menu)
509 Lisp_Object menu;
511 Lisp_Object tail;
513 init_menu_items ();
515 for (tail = menu; CONSP (tail); tail = XCDR (tail))
517 Lisp_Object elt, pane_name, pane_data;
518 elt = XCAR (tail);
519 pane_name = Fcar (elt);
520 CHECK_STRING (pane_name);
521 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
522 pane_data = Fcdr (elt);
523 CHECK_CONS (pane_data);
524 list_of_items (pane_data);
527 finish_menu_items ();
530 /* Set up data in menu_items for a menu bar item
531 whose event type is ITEM_KEY (with string ITEM_NAME)
532 and whose contents come from the list of keymaps MAPS. */
534 parse_single_submenu (item_key, item_name, maps)
535 Lisp_Object item_key, item_name, maps;
537 Lisp_Object length;
538 int len;
539 Lisp_Object *mapvec;
540 int i;
541 int top_level_items = 0;
543 length = Flength (maps);
544 len = XINT (length);
546 /* Convert the list MAPS into a vector MAPVEC. */
547 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
548 for (i = 0; i < len; i++)
550 mapvec[i] = Fcar (maps);
551 maps = Fcdr (maps);
554 /* Loop over the given keymaps, making a pane for each map.
555 But don't make a pane that is empty--ignore that map instead. */
556 for (i = 0; i < len; i++)
558 if (!KEYMAPP (mapvec[i]))
560 /* Here we have a command at top level in the menu bar
561 as opposed to a submenu. */
562 top_level_items = 1;
563 push_menu_pane (Qnil, Qnil);
564 push_menu_item (item_name, Qt, item_key, mapvec[i],
565 Qnil, Qnil, Qnil, Qnil);
567 else
569 Lisp_Object prompt;
570 prompt = Fkeymap_prompt (mapvec[i]);
571 single_keymap_panes (mapvec[i],
572 !NILP (prompt) ? prompt : item_name,
573 item_key, 10);
577 return top_level_items;
581 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
583 /* Allocate a widget_value, blocking input. */
585 widget_value *
586 xmalloc_widget_value ()
588 widget_value *value;
590 BLOCK_INPUT;
591 value = malloc_widget_value ();
592 UNBLOCK_INPUT;
594 return value;
597 /* This recursively calls free_widget_value on the tree of widgets.
598 It must free all data that was malloc'ed for these widget_values.
599 In Emacs, many slots are pointers into the data of Lisp_Strings, and
600 must be left alone. */
602 void
603 free_menubar_widget_value_tree (wv)
604 widget_value *wv;
606 if (! wv) return;
608 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
610 if (wv->contents && (wv->contents != (widget_value*)1))
612 free_menubar_widget_value_tree (wv->contents);
613 wv->contents = (widget_value *) 0xDEADBEEF;
615 if (wv->next)
617 free_menubar_widget_value_tree (wv->next);
618 wv->next = (widget_value *) 0xDEADBEEF;
620 BLOCK_INPUT;
621 free_widget_value (wv);
622 UNBLOCK_INPUT;
625 /* Create a tree of widget_value objects
626 representing the panes and items
627 in menu_items starting at index START, up to index END. */
629 widget_value *
630 digest_single_submenu (start, end, top_level_items)
631 int start, end, top_level_items;
633 widget_value *wv, *prev_wv, *save_wv, *first_wv;
634 int i;
635 int submenu_depth = 0;
636 widget_value **submenu_stack;
637 int panes_seen = 0;
639 submenu_stack
640 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
641 wv = xmalloc_widget_value ();
642 wv->name = "menu";
643 wv->value = 0;
644 wv->enabled = 1;
645 wv->button_type = BUTTON_TYPE_NONE;
646 wv->help = Qnil;
647 first_wv = wv;
648 save_wv = 0;
649 prev_wv = 0;
651 /* Loop over all panes and items made by the preceding call
652 to parse_single_submenu and construct a tree of widget_value objects.
653 Ignore the panes and items used by previous calls to
654 digest_single_submenu, even though those are also in menu_items. */
655 i = start;
656 while (i < end)
658 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
660 submenu_stack[submenu_depth++] = save_wv;
661 save_wv = prev_wv;
662 prev_wv = 0;
663 i++;
665 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
667 prev_wv = save_wv;
668 save_wv = submenu_stack[--submenu_depth];
669 i++;
671 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
672 && submenu_depth != 0)
673 i += MENU_ITEMS_PANE_LENGTH;
674 /* Ignore a nil in the item list.
675 It's meaningful only for dialog boxes. */
676 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
677 i += 1;
678 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
680 /* Create a new pane. */
681 Lisp_Object pane_name, prefix;
682 char *pane_string;
684 panes_seen++;
686 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
687 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
689 #ifdef HAVE_NTGUI
690 if (STRINGP (pane_name))
692 if (unicode_append_menu)
693 /* Encode as UTF-8 for now. */
694 pane_name = ENCODE_UTF_8 (pane_name);
695 else if (STRING_MULTIBYTE (pane_name))
696 pane_name = ENCODE_SYSTEM (pane_name);
698 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
700 #elif defined (USE_LUCID) && defined (HAVE_XFT)
701 if (STRINGP (pane_name))
703 pane_name = ENCODE_UTF_8 (pane_name);
704 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
706 #elif !defined (HAVE_MULTILINGUAL_MENU)
707 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
709 pane_name = ENCODE_MENU_STRING (pane_name);
710 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
712 #endif
714 pane_string = (NILP (pane_name)
715 ? "" : (char *) SDATA (pane_name));
716 /* If there is just one top-level pane, put all its items directly
717 under the top-level menu. */
718 if (menu_items_n_panes == 1)
719 pane_string = "";
721 /* If the pane has a meaningful name,
722 make the pane a top-level menu item
723 with its items as a submenu beneath it. */
724 if (strcmp (pane_string, ""))
726 wv = xmalloc_widget_value ();
727 if (save_wv)
728 save_wv->next = wv;
729 else
730 first_wv->contents = wv;
731 wv->lname = pane_name;
732 /* Set value to 1 so update_submenu_strings can handle '@' */
733 wv->value = (char *)1;
734 wv->enabled = 1;
735 wv->button_type = BUTTON_TYPE_NONE;
736 wv->help = Qnil;
737 save_wv = wv;
739 else
740 save_wv = first_wv;
742 prev_wv = 0;
743 i += MENU_ITEMS_PANE_LENGTH;
745 else
747 /* Create a new item within current pane. */
748 Lisp_Object item_name, enable, descrip, def, type, selected;
749 Lisp_Object help;
751 /* All items should be contained in panes. */
752 if (panes_seen == 0)
753 abort ();
755 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
756 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
757 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
758 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
759 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
760 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
761 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
763 #ifdef HAVE_NTGUI
764 if (STRINGP (item_name))
766 if (unicode_append_menu)
767 item_name = ENCODE_UTF_8 (item_name);
768 else if (STRING_MULTIBYTE (item_name))
769 item_name = ENCODE_SYSTEM (item_name);
771 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
774 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
776 descrip = ENCODE_SYSTEM (descrip);
777 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
779 #elif USE_LUCID
780 if (STRINGP (item_name))
782 item_name = ENCODE_UTF_8 (item_name);
783 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
786 if (STRINGP (descrip))
788 descrip = ENCODE_UTF_8 (descrip);
789 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
791 #elif !defined (HAVE_MULTILINGUAL_MENU)
792 if (STRING_MULTIBYTE (item_name))
794 item_name = ENCODE_MENU_STRING (item_name);
795 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
798 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
800 descrip = ENCODE_MENU_STRING (descrip);
801 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
803 #endif
805 wv = xmalloc_widget_value ();
806 if (prev_wv)
807 prev_wv->next = wv;
808 else
809 save_wv->contents = wv;
811 wv->lname = item_name;
812 if (!NILP (descrip))
813 wv->lkey = descrip;
814 wv->value = 0;
815 /* The EMACS_INT cast avoids a warning. There's no problem
816 as long as pointers have enough bits to hold small integers. */
817 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
818 wv->enabled = !NILP (enable);
820 if (NILP (type))
821 wv->button_type = BUTTON_TYPE_NONE;
822 else if (EQ (type, QCradio))
823 wv->button_type = BUTTON_TYPE_RADIO;
824 else if (EQ (type, QCtoggle))
825 wv->button_type = BUTTON_TYPE_TOGGLE;
826 else
827 abort ();
829 wv->selected = !NILP (selected);
830 if (! STRINGP (help))
831 help = Qnil;
833 wv->help = help;
835 prev_wv = wv;
837 i += MENU_ITEMS_ITEM_LENGTH;
841 /* If we have just one "menu item"
842 that was originally a button, return it by itself. */
843 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
845 wv = first_wv->contents;
846 free_widget_value (first_wv);
847 return wv;
850 return first_wv;
853 /* Walk through the widget_value tree starting at FIRST_WV and update
854 the char * pointers from the corresponding lisp values.
855 We do this after building the whole tree, since GC may happen while the
856 tree is constructed, and small strings are relocated. So we must wait
857 until no GC can happen before storing pointers into lisp values. */
858 void
859 update_submenu_strings (first_wv)
860 widget_value *first_wv;
862 widget_value *wv;
864 for (wv = first_wv; wv; wv = wv->next)
866 if (STRINGP (wv->lname))
868 wv->name = (char *) SDATA (wv->lname);
870 /* Ignore the @ that means "separate pane".
871 This is a kludge, but this isn't worth more time. */
872 if (wv->value == (char *)1)
874 if (wv->name[0] == '@')
875 wv->name++;
876 wv->value = 0;
880 if (STRINGP (wv->lkey))
881 wv->key = (char *) SDATA (wv->lkey);
883 if (wv->contents)
884 update_submenu_strings (wv->contents);
888 /* Find the menu selection and store it in the keyboard buffer.
889 F is the frame the menu is on.
890 MENU_BAR_ITEMS_USED is the length of VECTOR.
891 VECTOR is an array of menu events for the whole menu. */
893 void
894 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
895 FRAME_PTR f;
896 int menu_bar_items_used;
897 Lisp_Object vector;
898 void *client_data;
900 Lisp_Object prefix, entry;
901 Lisp_Object *subprefix_stack;
902 int submenu_depth = 0;
903 int i;
905 entry = Qnil;
906 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
907 prefix = Qnil;
908 i = 0;
910 while (i < menu_bar_items_used)
912 if (EQ (XVECTOR (vector)->contents[i], Qnil))
914 subprefix_stack[submenu_depth++] = prefix;
915 prefix = entry;
916 i++;
918 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
920 prefix = subprefix_stack[--submenu_depth];
921 i++;
923 else if (EQ (XVECTOR (vector)->contents[i], Qt))
925 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
926 i += MENU_ITEMS_PANE_LENGTH;
928 else
930 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
931 /* The EMACS_INT cast avoids a warning. There's no problem
932 as long as pointers have enough bits to hold small integers. */
933 if ((int) (EMACS_INT) client_data == i)
935 int j;
936 struct input_event buf;
937 Lisp_Object frame;
938 EVENT_INIT (buf);
940 XSETFRAME (frame, f);
941 buf.kind = MENU_BAR_EVENT;
942 buf.frame_or_window = frame;
943 buf.arg = frame;
944 kbd_buffer_store_event (&buf);
946 for (j = 0; j < submenu_depth; j++)
947 if (!NILP (subprefix_stack[j]))
949 buf.kind = MENU_BAR_EVENT;
950 buf.frame_or_window = frame;
951 buf.arg = subprefix_stack[j];
952 kbd_buffer_store_event (&buf);
955 if (!NILP (prefix))
957 buf.kind = MENU_BAR_EVENT;
958 buf.frame_or_window = frame;
959 buf.arg = prefix;
960 kbd_buffer_store_event (&buf);
963 buf.kind = MENU_BAR_EVENT;
964 buf.frame_or_window = frame;
965 buf.arg = entry;
966 kbd_buffer_store_event (&buf);
968 return;
970 i += MENU_ITEMS_ITEM_LENGTH;
975 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
977 #ifdef HAVE_NS
978 /* As above, but return the menu selection instead of storing in kb buffer.
979 If keymaps==1, return full prefixes to selection. */
980 Lisp_Object
981 find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
983 Lisp_Object prefix, entry;
984 int i;
985 Lisp_Object *subprefix_stack;
986 int submenu_depth = 0;
988 prefix = entry = Qnil;
989 i = 0;
990 subprefix_stack =
991 (Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
993 while (i < menu_items_used)
995 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
997 subprefix_stack[submenu_depth++] = prefix;
998 prefix = entry;
999 i++;
1001 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1003 prefix = subprefix_stack[--submenu_depth];
1004 i++;
1006 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1008 prefix
1009 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1010 i += MENU_ITEMS_PANE_LENGTH;
1012 /* Ignore a nil in the item list.
1013 It's meaningful only for dialog boxes. */
1014 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1015 i += 1;
1016 else
1018 entry
1019 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1020 if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
1022 if (keymaps != 0)
1024 int j;
1026 entry = Fcons (entry, Qnil);
1027 if (!NILP (prefix))
1028 entry = Fcons (prefix, entry);
1029 for (j = submenu_depth - 1; j >= 0; j--)
1030 if (!NILP (subprefix_stack[j]))
1031 entry = Fcons (subprefix_stack[j], entry);
1033 return entry;
1035 i += MENU_ITEMS_ITEM_LENGTH;
1038 return Qnil;
1040 #endif /* HAVE_NS */
1042 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1043 doc: /* Pop up a deck-of-cards menu and return user's selection.
1044 POSITION is a position specification. This is either a mouse button event
1045 or a list ((XOFFSET YOFFSET) WINDOW)
1046 where XOFFSET and YOFFSET are positions in pixels from the top left
1047 corner of WINDOW. (WINDOW may be a window or a frame object.)
1048 This controls the position of the top left of the menu as a whole.
1049 If POSITION is t, it means to use the current mouse position.
1051 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1052 The menu items come from key bindings that have a menu string as well as
1053 a definition; actually, the "definition" in such a key binding looks like
1054 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1055 the keymap as a top-level element.
1057 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1058 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1060 You can also use a list of keymaps as MENU.
1061 Then each keymap makes a separate pane.
1063 When MENU is a keymap or a list of keymaps, the return value is the
1064 list of events corresponding to the user's choice. Note that
1065 `x-popup-menu' does not actually execute the command bound to that
1066 sequence of events.
1068 Alternatively, you can specify a menu of multiple panes
1069 with a list of the form (TITLE PANE1 PANE2...),
1070 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1071 Each ITEM is normally a cons cell (STRING . VALUE);
1072 but a string can appear as an item--that makes a nonselectable line
1073 in the menu.
1074 With this form of menu, the return value is VALUE from the chosen item.
1076 If POSITION is nil, don't display the menu at all, just precalculate the
1077 cached information about equivalent key sequences.
1079 If the user gets rid of the menu without making a valid choice, for
1080 instance by clicking the mouse away from a valid choice or by typing
1081 keyboard input, then this normally results in a quit and
1082 `x-popup-menu' does not return. But if POSITION is a mouse button
1083 event (indicating that the user invoked the menu with the mouse) then
1084 no quit occurs and `x-popup-menu' returns nil. */)
1085 (position, menu)
1086 Lisp_Object position, menu;
1088 Lisp_Object keymap, tem;
1089 int xpos = 0, ypos = 0;
1090 Lisp_Object title;
1091 char *error_name = NULL;
1092 Lisp_Object selection = Qnil;
1093 FRAME_PTR f = NULL;
1094 Lisp_Object x, y, window;
1095 int keymaps = 0;
1096 int for_click = 0;
1097 int specpdl_count = SPECPDL_INDEX ();
1098 struct gcpro gcpro1;
1100 if (NILP (position))
1101 /* This is an obsolete call, which wants us to precompute the
1102 keybinding equivalents, but we don't do that any more anyway. */
1103 return Qnil;
1105 #ifdef HAVE_MENUS
1107 int get_current_pos_p = 0;
1108 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1110 /* Decode the first argument: find the window and the coordinates. */
1111 if (EQ (position, Qt)
1112 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1113 || EQ (XCAR (position), Qtool_bar))))
1115 get_current_pos_p = 1;
1117 else
1119 tem = Fcar (position);
1120 if (CONSP (tem))
1122 window = Fcar (Fcdr (position));
1123 x = XCAR (tem);
1124 y = Fcar (XCDR (tem));
1126 else
1128 for_click = 1;
1129 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1130 window = Fcar (tem); /* POSN_WINDOW (tem) */
1131 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1132 x = Fcar (tem);
1133 y = Fcdr (tem);
1136 /* If a click happens in an external tool bar or a detached
1137 tool bar, x and y is NIL. In that case, use the current
1138 mouse position. This happens for the help button in the
1139 tool bar. Ideally popup-menu should pass NIL to
1140 this function, but it doesn't. */
1141 if (NILP (x) && NILP (y))
1142 get_current_pos_p = 1;
1145 if (get_current_pos_p)
1147 /* Use the mouse's current position. */
1148 FRAME_PTR new_f = SELECTED_FRAME ();
1149 #ifdef HAVE_X_WINDOWS
1150 /* Can't use mouse_position_hook for X since it returns
1151 coordinates relative to the window the mouse is in,
1152 we need coordinates relative to the edit widget always. */
1153 if (new_f != 0)
1155 int cur_x, cur_y;
1157 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1158 /* cur_x/y may be negative, so use make_number. */
1159 x = make_number (cur_x);
1160 y = make_number (cur_y);
1163 #else /* not HAVE_X_WINDOWS */
1164 Lisp_Object bar_window;
1165 enum scroll_bar_part part;
1166 unsigned long time;
1167 void (*mouse_position_hook) P_ ((struct frame **, int,
1168 Lisp_Object *,
1169 enum scroll_bar_part *,
1170 Lisp_Object *,
1171 Lisp_Object *,
1172 unsigned long *)) =
1173 FRAME_TERMINAL (new_f)->mouse_position_hook;
1175 if (mouse_position_hook)
1176 (*mouse_position_hook) (&new_f, 1, &bar_window,
1177 &part, &x, &y, &time);
1178 #endif /* not HAVE_X_WINDOWS */
1180 if (new_f != 0)
1181 XSETFRAME (window, new_f);
1182 else
1184 window = selected_window;
1185 XSETFASTINT (x, 0);
1186 XSETFASTINT (y, 0);
1190 CHECK_NUMBER (x);
1191 CHECK_NUMBER (y);
1193 /* Decode where to put the menu. */
1195 if (FRAMEP (window))
1197 f = XFRAME (window);
1198 xpos = 0;
1199 ypos = 0;
1201 else if (WINDOWP (window))
1203 struct window *win = XWINDOW (window);
1204 CHECK_LIVE_WINDOW (window);
1205 f = XFRAME (WINDOW_FRAME (win));
1207 xpos = WINDOW_LEFT_EDGE_X (win);
1208 ypos = WINDOW_TOP_EDGE_Y (win);
1210 else
1211 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1212 but I don't want to make one now. */
1213 CHECK_WINDOW (window);
1215 xpos += XINT (x);
1216 ypos += XINT (y);
1218 /* FIXME: Find a more general check! */
1219 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1220 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1221 error ("Can not put GUI menu on this terminal");
1223 XSETFRAME (Vmenu_updating_frame, f);
1225 #endif /* HAVE_MENUS */
1227 /* Now parse the lisp menus. */
1228 record_unwind_protect (unuse_menu_items, Qnil);
1230 title = Qnil;
1231 GCPRO1 (title);
1233 /* Decode the menu items from what was specified. */
1235 keymap = get_keymap (menu, 0, 0);
1236 if (CONSP (keymap))
1238 /* We were given a keymap. Extract menu info from the keymap. */
1239 Lisp_Object prompt;
1241 /* Extract the detailed info to make one pane. */
1242 keymap_panes (&menu, 1);
1244 /* Search for a string appearing directly as an element of the keymap.
1245 That string is the title of the menu. */
1246 prompt = Fkeymap_prompt (keymap);
1247 if (!NILP (prompt))
1248 title = prompt;
1249 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1250 else
1251 title = build_string ("Select");
1252 #endif
1254 /* Make that be the pane title of the first pane. */
1255 if (!NILP (prompt) && menu_items_n_panes >= 0)
1256 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1258 keymaps = 1;
1260 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1262 /* We were given a list of keymaps. */
1263 int nmaps = XFASTINT (Flength (menu));
1264 Lisp_Object *maps
1265 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1266 int i;
1268 title = Qnil;
1270 /* The first keymap that has a prompt string
1271 supplies the menu title. */
1272 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1274 Lisp_Object prompt;
1276 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1278 prompt = Fkeymap_prompt (keymap);
1279 if (NILP (title) && !NILP (prompt))
1280 title = prompt;
1283 /* Extract the detailed info to make one pane. */
1284 keymap_panes (maps, nmaps);
1286 /* Make the title be the pane title of the first pane. */
1287 if (!NILP (title) && menu_items_n_panes >= 0)
1288 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1290 keymaps = 1;
1292 else
1294 /* We were given an old-fashioned menu. */
1295 title = Fcar (menu);
1296 CHECK_STRING (title);
1298 list_of_panes (Fcdr (menu));
1300 keymaps = 0;
1303 unbind_to (specpdl_count, Qnil);
1305 #ifdef HAVE_MENUS
1306 #ifdef HAVE_WINDOW_SYSTEM
1307 /* Hide a previous tip, if any. */
1308 Fx_hide_tip ();
1309 #endif
1311 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1312 /* If resources from a previous popup menu still exist, does nothing
1313 until the `menu_free_timer' has freed them (see w32fns.c). This
1314 can occur if you press ESC or click outside a menu without selecting
1315 a menu item.
1317 if (current_popup_menu)
1319 discard_menu_items ();
1320 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1321 UNGCPRO;
1322 return Qnil;
1324 #endif
1326 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1327 record_unwind_protect (cleanup_popup_menu, Qnil);
1328 #endif
1330 /* Display them in a menu. */
1331 BLOCK_INPUT;
1333 /* FIXME: Use a terminal hook! */
1334 #if defined HAVE_NTGUI
1335 selection = w32_menu_show (f, xpos, ypos, for_click,
1336 keymaps, title, &error_name);
1337 #elif defined HAVE_NS
1338 selection = ns_menu_show (f, xpos, ypos, for_click,
1339 keymaps, title, &error_name);
1340 #else /* MSDOS and X11 */
1341 /* Assume last_event_timestamp is the timestamp of the button event.
1342 Is this assumption ever violated? We can't use the timestamp
1343 stored within POSITION because there the top bits from the actual
1344 timestamp may be truncated away (Bug#4930). */
1345 selection = xmenu_show (f, xpos, ypos, for_click,
1346 keymaps, title, &error_name,
1347 last_event_timestamp);
1348 #endif
1350 UNBLOCK_INPUT;
1352 #ifdef HAVE_NS
1353 unbind_to (specpdl_count, Qnil);
1354 #else
1355 discard_menu_items ();
1356 #endif
1358 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1359 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1360 #endif
1362 #endif /* HAVE_MENUS */
1364 UNGCPRO;
1366 if (error_name) error (error_name);
1367 return selection;
1370 void
1371 syms_of_menu ()
1373 staticpro (&menu_items);
1374 menu_items = Qnil;
1375 menu_items_inuse = Qnil;
1377 defsubr (&Sx_popup_menu);
1380 /* arch-tag: 78bbc7cf-8025-4156-aa8a-6c7fd99bf51d
1381 (do not change this comment) */