Fix race conditions with signal handlers and errno.
[emacs.git] / src / menu.c
blobbfdc68ca11870b4d05ea93afd4ed08841c44972b
1 /* Platform-independent code for terminal communications.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2012
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
22 #include <stdio.h>
23 #include <setjmp.h>
24 #include <limits.h> /* for INT_MAX */
26 #include "lisp.h"
27 #include "keyboard.h"
28 #include "keymap.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "termhooks.h"
32 #include "blockinput.h"
33 #include "dispextern.h"
35 #ifdef USE_X_TOOLKIT
36 #include "../lwlib/lwlib.h"
37 #endif
39 #ifdef HAVE_WINDOW_SYSTEM
40 #include TERM_HEADER
41 #endif /* HAVE_WINDOW_SYSTEM */
43 #ifdef HAVE_NTGUI
44 extern AppendMenuW_Proc unicode_append_menu;
45 extern HMENU current_popup_menu;
46 #endif /* HAVE_NTGUI */
48 #include "menu.h"
50 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
51 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
52 #define HAVE_BOXES 1
53 #endif
55 Lisp_Object menu_items;
57 /* If non-nil, means that the global vars defined here are already in use.
58 Used to detect cases where we try to re-enter this non-reentrant code. */
59 #if ! (defined USE_GTK || defined USE_MOTIF)
60 static
61 #endif
62 Lisp_Object menu_items_inuse;
64 /* Number of slots currently allocated in menu_items. */
65 int menu_items_allocated;
67 /* This is the index in menu_items of the first empty slot. */
68 int menu_items_used;
70 /* The number of panes currently recorded in menu_items,
71 excluding those within submenus. */
72 int menu_items_n_panes;
74 /* Current depth within submenus. */
75 static int menu_items_submenu_depth;
77 void
78 init_menu_items (void)
80 if (!NILP (menu_items_inuse))
81 error ("Trying to use a menu from within a menu-entry");
83 if (NILP (menu_items))
85 menu_items_allocated = 60;
86 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
89 menu_items_inuse = Qt;
90 menu_items_used = 0;
91 menu_items_n_panes = 0;
92 menu_items_submenu_depth = 0;
95 /* Call at the end of generating the data in menu_items. */
97 void
98 finish_menu_items (void)
102 Lisp_Object
103 unuse_menu_items (Lisp_Object dummy)
105 return menu_items_inuse = Qnil;
108 /* Call when finished using the data for the current menu
109 in menu_items. */
111 void
112 discard_menu_items (void)
114 /* Free the structure if it is especially large.
115 Otherwise, hold on to it, to save time. */
116 if (menu_items_allocated > 200)
118 menu_items = Qnil;
119 menu_items_allocated = 0;
121 eassert (NILP (menu_items_inuse));
124 #ifdef HAVE_NS
125 static Lisp_Object
126 cleanup_popup_menu (Lisp_Object arg)
128 discard_menu_items ();
129 return Qnil;
131 #endif
133 /* This undoes save_menu_items, and it is called by the specpdl unwind
134 mechanism. */
136 static Lisp_Object
137 restore_menu_items (Lisp_Object saved)
139 menu_items = XCAR (saved);
140 menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
141 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
142 saved = XCDR (saved);
143 menu_items_used = XINT (XCAR (saved));
144 saved = XCDR (saved);
145 menu_items_n_panes = XINT (XCAR (saved));
146 saved = XCDR (saved);
147 menu_items_submenu_depth = XINT (XCAR (saved));
148 return Qnil;
151 /* Push the whole state of menu_items processing onto the specpdl.
152 It will be restored when the specpdl is unwound. */
154 void
155 save_menu_items (void)
157 Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
158 make_number (menu_items_used),
159 make_number (menu_items_n_panes),
160 make_number (menu_items_submenu_depth));
161 record_unwind_protect (restore_menu_items, saved);
162 menu_items_inuse = Qnil;
163 menu_items = Qnil;
167 /* Ensure that there is room for ITEMS items in the menu_items vector. */
169 static void
170 ensure_menu_items (int items)
172 int incr = items - (menu_items_allocated - menu_items_used);
173 if (0 < incr)
175 menu_items = larger_vector (menu_items, incr, INT_MAX);
176 menu_items_allocated = ASIZE (menu_items);
180 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
181 || defined HAVE_NTGUI)
183 /* Begin a submenu. */
185 static void
186 push_submenu_start (void)
188 ensure_menu_items (1);
189 ASET (menu_items, menu_items_used, Qnil);
190 menu_items_used++;
191 menu_items_submenu_depth++;
194 /* End a submenu. */
196 static void
197 push_submenu_end (void)
199 ensure_menu_items (1);
200 ASET (menu_items, menu_items_used, Qlambda);
201 menu_items_used++;
202 menu_items_submenu_depth--;
205 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
207 /* Indicate boundary between left and right. */
209 static void
210 push_left_right_boundary (void)
212 ensure_menu_items (1);
213 ASET (menu_items, menu_items_used, Qquote);
214 menu_items_used++;
217 /* Start a new menu pane in menu_items.
218 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
220 static void
221 push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
223 ensure_menu_items (MENU_ITEMS_PANE_LENGTH);
224 if (menu_items_submenu_depth == 0)
225 menu_items_n_panes++;
226 ASET (menu_items, menu_items_used, Qt);
227 menu_items_used++;
228 ASET (menu_items, menu_items_used, name);
229 menu_items_used++;
230 ASET (menu_items, menu_items_used, prefix_vec);
231 menu_items_used++;
234 /* Push one menu item into the current pane. NAME is the string to
235 display. ENABLE if non-nil means this item can be selected. KEY
236 is the key generated by choosing this item, or nil if this item
237 doesn't really have a definition. DEF is the definition of this
238 item. EQUIV is the textual description of the keyboard equivalent
239 for this item (or nil if none). TYPE is the type of this menu
240 item, one of nil, `toggle' or `radio'. */
242 static void
243 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)
245 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH);
247 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
248 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
249 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
250 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
251 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
252 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
253 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
254 ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
256 menu_items_used += MENU_ITEMS_ITEM_LENGTH;
259 /* Args passed between single_keymap_panes and single_menu_item. */
260 struct skp
262 Lisp_Object pending_maps;
263 int maxdepth;
264 int notbuttons;
267 static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
268 void *);
270 /* This is a recursive subroutine of keymap_panes.
271 It handles one keymap, KEYMAP.
272 The other arguments are passed along
273 or point to local variables of the previous function.
275 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
277 static void
278 single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
279 Lisp_Object prefix, int maxdepth)
281 struct skp skp;
282 struct gcpro gcpro1;
284 skp.pending_maps = Qnil;
285 skp.maxdepth = maxdepth;
286 skp.notbuttons = 0;
288 if (maxdepth <= 0)
289 return;
291 push_menu_pane (pane_name, prefix);
293 #ifndef HAVE_BOXES
294 /* Remember index for first item in this pane so we can go back and
295 add a prefix when (if) we see the first button. After that, notbuttons
296 is set to 0, to mark that we have seen a button and all non button
297 items need a prefix. */
298 skp.notbuttons = menu_items_used;
299 #endif
301 GCPRO1 (skp.pending_maps);
302 map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
303 UNGCPRO;
305 /* Process now any submenus which want to be panes at this level. */
306 while (CONSP (skp.pending_maps))
308 Lisp_Object elt, eltcdr, string;
309 elt = XCAR (skp.pending_maps);
310 eltcdr = XCDR (elt);
311 string = XCAR (eltcdr);
312 /* We no longer discard the @ from the beginning of the string here.
313 Instead, we do this in *menu_show. */
314 single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
315 skp.pending_maps = XCDR (skp.pending_maps);
319 /* This is a subroutine of single_keymap_panes that handles one
320 keymap entry.
321 KEY is a key in a keymap and ITEM is its binding.
322 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
323 separate panes.
324 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
326 static void
327 single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
329 Lisp_Object map, item_string, enabled;
330 struct gcpro gcpro1, gcpro2;
331 int res;
332 struct skp *skp = skp_v;
334 /* Parse the menu item and leave the result in item_properties. */
335 GCPRO2 (key, item);
336 res = parse_menu_item (item, 0);
337 UNGCPRO;
338 if (!res)
339 return; /* Not a menu item. */
341 map = AREF (item_properties, ITEM_PROPERTY_MAP);
343 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
344 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
346 if (!NILP (map) && SREF (item_string, 0) == '@')
348 if (!NILP (enabled))
349 /* An enabled separate pane. Remember this to handle it later. */
350 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
351 skp->pending_maps);
352 return;
355 #if defined (HAVE_X_WINDOWS) || defined (MSDOS)
356 #ifndef HAVE_BOXES
357 /* Simulate radio buttons and toggle boxes by putting a prefix in
358 front of them. */
360 Lisp_Object prefix = Qnil;
361 Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
362 if (!NILP (type))
364 Lisp_Object selected
365 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
367 if (skp->notbuttons)
368 /* The first button. Line up previous items in this menu. */
370 int idx = skp->notbuttons; /* Index for first item this menu. */
371 int submenu = 0;
372 Lisp_Object tem;
373 while (idx < menu_items_used)
376 = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME);
377 if (NILP (tem))
379 idx++;
380 submenu++; /* Skip sub menu. */
382 else if (EQ (tem, Qlambda))
384 idx++;
385 submenu--; /* End sub menu. */
387 else if (EQ (tem, Qt))
388 idx += 3; /* Skip new pane marker. */
389 else if (EQ (tem, Qquote))
390 idx++; /* Skip a left, right divider. */
391 else
393 if (!submenu && SREF (tem, 0) != '\0'
394 && SREF (tem, 0) != '-')
395 ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
396 concat2 (build_string (" "), tem));
397 idx += MENU_ITEMS_ITEM_LENGTH;
400 skp->notbuttons = 0;
403 /* Calculate prefix, if any, for this item. */
404 if (EQ (type, QCtoggle))
405 prefix = build_string (NILP (selected) ? "[ ] " : "[X] ");
406 else if (EQ (type, QCradio))
407 prefix = build_string (NILP (selected) ? "( ) " : "(*) ");
409 /* Not a button. If we have earlier buttons, then we need a prefix. */
410 else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
411 && SREF (item_string, 0) != '-')
412 prefix = build_string (" ");
414 if (!NILP (prefix))
415 item_string = concat2 (prefix, item_string);
417 #endif /* not HAVE_BOXES */
419 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
420 if (!NILP (map))
421 /* Indicate visually that this is a submenu. */
422 item_string = concat2 (item_string, build_string (" >"));
423 #endif
425 #endif /* HAVE_X_WINDOWS || MSDOS */
427 push_menu_item (item_string, enabled, key,
428 AREF (item_properties, ITEM_PROPERTY_DEF),
429 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
430 AREF (item_properties, ITEM_PROPERTY_TYPE),
431 AREF (item_properties, ITEM_PROPERTY_SELECTED),
432 AREF (item_properties, ITEM_PROPERTY_HELP));
434 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
435 /* Display a submenu using the toolkit. */
436 if (! (NILP (map) || NILP (enabled)))
438 push_submenu_start ();
439 single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
440 push_submenu_end ();
442 #endif
445 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
446 and generate menu panes for them in menu_items. */
448 static void
449 keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps)
451 ptrdiff_t mapno;
453 init_menu_items ();
455 /* Loop over the given keymaps, making a pane for each map.
456 But don't make a pane that is empty--ignore that map instead.
457 P is the number of panes we have made so far. */
458 for (mapno = 0; mapno < nmaps; mapno++)
459 single_keymap_panes (keymaps[mapno],
460 Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
462 finish_menu_items ();
466 /* Push the items in a single pane defined by the alist PANE. */
467 static void
468 list_of_items (Lisp_Object pane)
470 Lisp_Object tail, item, item1;
472 for (tail = pane; CONSP (tail); tail = XCDR (tail))
474 item = XCAR (tail);
475 if (STRINGP (item))
476 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
477 Qnil, Qnil, Qnil, Qnil);
478 else if (CONSP (item))
480 item1 = XCAR (item);
481 CHECK_STRING (item1);
482 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
483 Qt, Qnil, Qnil, Qnil, Qnil);
485 else
486 push_left_right_boundary ();
491 /* Push all the panes and items of a menu described by the
492 alist-of-alists MENU.
493 This handles old-fashioned calls to x-popup-menu. */
494 void
495 list_of_panes (Lisp_Object menu)
497 Lisp_Object tail;
499 init_menu_items ();
501 for (tail = menu; CONSP (tail); tail = XCDR (tail))
503 Lisp_Object elt, pane_name, pane_data;
504 elt = XCAR (tail);
505 pane_name = Fcar (elt);
506 CHECK_STRING (pane_name);
507 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
508 pane_data = Fcdr (elt);
509 CHECK_CONS (pane_data);
510 list_of_items (pane_data);
513 finish_menu_items ();
516 /* Set up data in menu_items for a menu bar item
517 whose event type is ITEM_KEY (with string ITEM_NAME)
518 and whose contents come from the list of keymaps MAPS. */
520 parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
522 Lisp_Object length;
523 EMACS_INT len;
524 Lisp_Object *mapvec;
525 ptrdiff_t i;
526 int top_level_items = 0;
527 USE_SAFE_ALLOCA;
529 length = Flength (maps);
530 len = XINT (length);
532 /* Convert the list MAPS into a vector MAPVEC. */
533 SAFE_ALLOCA_LISP (mapvec, len);
534 for (i = 0; i < len; i++)
536 mapvec[i] = Fcar (maps);
537 maps = Fcdr (maps);
540 /* Loop over the given keymaps, making a pane for each map.
541 But don't make a pane that is empty--ignore that map instead. */
542 for (i = 0; i < len; i++)
544 if (!KEYMAPP (mapvec[i]))
546 /* Here we have a command at top level in the menu bar
547 as opposed to a submenu. */
548 top_level_items = 1;
549 push_menu_pane (Qnil, Qnil);
550 push_menu_item (item_name, Qt, item_key, mapvec[i],
551 Qnil, Qnil, Qnil, Qnil);
553 else
555 Lisp_Object prompt;
556 prompt = Fkeymap_prompt (mapvec[i]);
557 single_keymap_panes (mapvec[i],
558 !NILP (prompt) ? prompt : item_name,
559 item_key, 10);
563 SAFE_FREE ();
564 return top_level_items;
568 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
570 /* Allocate a widget_value, blocking input. */
572 widget_value *
573 xmalloc_widget_value (void)
575 widget_value *value;
577 BLOCK_INPUT;
578 value = malloc_widget_value ();
579 UNBLOCK_INPUT;
581 return value;
584 /* This recursively calls free_widget_value on the tree of widgets.
585 It must free all data that was malloc'ed for these widget_values.
586 In Emacs, many slots are pointers into the data of Lisp_Strings, and
587 must be left alone. */
589 void
590 free_menubar_widget_value_tree (widget_value *wv)
592 if (! wv) return;
594 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
596 if (wv->contents && (wv->contents != (widget_value*)1))
598 free_menubar_widget_value_tree (wv->contents);
599 wv->contents = (widget_value *) 0xDEADBEEF;
601 if (wv->next)
603 free_menubar_widget_value_tree (wv->next);
604 wv->next = (widget_value *) 0xDEADBEEF;
606 BLOCK_INPUT;
607 free_widget_value (wv);
608 UNBLOCK_INPUT;
611 /* Create a tree of widget_value objects
612 representing the panes and items
613 in menu_items starting at index START, up to index END. */
615 widget_value *
616 digest_single_submenu (int start, int end, int top_level_items)
618 widget_value *wv, *prev_wv, *save_wv, *first_wv;
619 int i;
620 int submenu_depth = 0;
621 widget_value **submenu_stack;
622 int panes_seen = 0;
624 submenu_stack = alloca (menu_items_used * sizeof *submenu_stack);
625 wv = xmalloc_widget_value ();
626 wv->name = "menu";
627 wv->value = 0;
628 wv->enabled = 1;
629 wv->button_type = BUTTON_TYPE_NONE;
630 wv->help = Qnil;
631 first_wv = wv;
632 save_wv = 0;
633 prev_wv = 0;
635 /* Loop over all panes and items made by the preceding call
636 to parse_single_submenu and construct a tree of widget_value objects.
637 Ignore the panes and items used by previous calls to
638 digest_single_submenu, even though those are also in menu_items. */
639 i = start;
640 while (i < end)
642 if (EQ (AREF (menu_items, i), Qnil))
644 submenu_stack[submenu_depth++] = save_wv;
645 save_wv = prev_wv;
646 prev_wv = 0;
647 i++;
649 else if (EQ (AREF (menu_items, i), Qlambda))
651 prev_wv = save_wv;
652 save_wv = submenu_stack[--submenu_depth];
653 i++;
655 else if (EQ (AREF (menu_items, i), Qt)
656 && submenu_depth != 0)
657 i += MENU_ITEMS_PANE_LENGTH;
658 /* Ignore a nil in the item list.
659 It's meaningful only for dialog boxes. */
660 else if (EQ (AREF (menu_items, i), Qquote))
661 i += 1;
662 else if (EQ (AREF (menu_items, i), Qt))
664 /* Create a new pane. */
665 Lisp_Object pane_name;
666 const char *pane_string;
668 panes_seen++;
670 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
672 #ifdef HAVE_NTGUI
673 if (STRINGP (pane_name))
675 if (unicode_append_menu)
676 /* Encode as UTF-8 for now. */
677 pane_name = ENCODE_UTF_8 (pane_name);
678 else if (STRING_MULTIBYTE (pane_name))
679 pane_name = ENCODE_SYSTEM (pane_name);
681 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
683 #elif defined (USE_LUCID) && defined (HAVE_XFT)
684 if (STRINGP (pane_name))
686 pane_name = ENCODE_UTF_8 (pane_name);
687 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
689 #elif !defined (HAVE_MULTILINGUAL_MENU)
690 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
692 pane_name = ENCODE_MENU_STRING (pane_name);
693 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
695 #endif
697 pane_string = (NILP (pane_name)
698 ? "" : SSDATA (pane_name));
699 /* If there is just one top-level pane, put all its items directly
700 under the top-level menu. */
701 if (menu_items_n_panes == 1)
702 pane_string = "";
704 /* If the pane has a meaningful name,
705 make the pane a top-level menu item
706 with its items as a submenu beneath it. */
707 if (strcmp (pane_string, ""))
709 wv = xmalloc_widget_value ();
710 if (save_wv)
711 save_wv->next = wv;
712 else
713 first_wv->contents = wv;
714 wv->lname = pane_name;
715 /* Set value to 1 so update_submenu_strings can handle '@' */
716 wv->value = (char *)1;
717 wv->enabled = 1;
718 wv->button_type = BUTTON_TYPE_NONE;
719 wv->help = Qnil;
720 save_wv = wv;
722 else
723 save_wv = first_wv;
725 prev_wv = 0;
726 i += MENU_ITEMS_PANE_LENGTH;
728 else
730 /* Create a new item within current pane. */
731 Lisp_Object item_name, enable, descrip, def, type, selected;
732 Lisp_Object help;
734 /* All items should be contained in panes. */
735 if (panes_seen == 0)
736 emacs_abort ();
738 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
739 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
740 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
741 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
742 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
743 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
744 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
746 #ifdef HAVE_NTGUI
747 if (STRINGP (item_name))
749 if (unicode_append_menu)
750 item_name = ENCODE_UTF_8 (item_name);
751 else if (STRING_MULTIBYTE (item_name))
752 item_name = ENCODE_SYSTEM (item_name);
754 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
757 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
759 descrip = ENCODE_SYSTEM (descrip);
760 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
762 #elif USE_LUCID
763 if (STRINGP (item_name))
765 item_name = ENCODE_UTF_8 (item_name);
766 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
769 if (STRINGP (descrip))
771 descrip = ENCODE_UTF_8 (descrip);
772 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
774 #elif !defined (HAVE_MULTILINGUAL_MENU)
775 if (STRING_MULTIBYTE (item_name))
777 item_name = ENCODE_MENU_STRING (item_name);
778 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
781 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
783 descrip = ENCODE_MENU_STRING (descrip);
784 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
786 #endif
788 wv = xmalloc_widget_value ();
789 if (prev_wv)
790 prev_wv->next = wv;
791 else
792 save_wv->contents = wv;
794 wv->lname = item_name;
795 if (!NILP (descrip))
796 wv->lkey = descrip;
797 wv->value = 0;
798 /* The intptr_t cast avoids a warning. There's no problem
799 as long as pointers have enough bits to hold small integers. */
800 wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
801 wv->enabled = !NILP (enable);
803 if (NILP (type))
804 wv->button_type = BUTTON_TYPE_NONE;
805 else if (EQ (type, QCradio))
806 wv->button_type = BUTTON_TYPE_RADIO;
807 else if (EQ (type, QCtoggle))
808 wv->button_type = BUTTON_TYPE_TOGGLE;
809 else
810 emacs_abort ();
812 wv->selected = !NILP (selected);
813 if (! STRINGP (help))
814 help = Qnil;
816 wv->help = help;
818 prev_wv = wv;
820 i += MENU_ITEMS_ITEM_LENGTH;
824 /* If we have just one "menu item"
825 that was originally a button, return it by itself. */
826 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
828 wv = first_wv->contents;
829 free_widget_value (first_wv);
830 return wv;
833 return first_wv;
836 /* Walk through the widget_value tree starting at FIRST_WV and update
837 the char * pointers from the corresponding lisp values.
838 We do this after building the whole tree, since GC may happen while the
839 tree is constructed, and small strings are relocated. So we must wait
840 until no GC can happen before storing pointers into lisp values. */
841 void
842 update_submenu_strings (widget_value *first_wv)
844 widget_value *wv;
846 for (wv = first_wv; wv; wv = wv->next)
848 if (STRINGP (wv->lname))
850 wv->name = SSDATA (wv->lname);
852 /* Ignore the @ that means "separate pane".
853 This is a kludge, but this isn't worth more time. */
854 if (wv->value == (char *)1)
856 if (wv->name[0] == '@')
857 wv->name++;
858 wv->value = 0;
862 if (STRINGP (wv->lkey))
863 wv->key = SSDATA (wv->lkey);
865 if (wv->contents)
866 update_submenu_strings (wv->contents);
870 /* Find the menu selection and store it in the keyboard buffer.
871 F is the frame the menu is on.
872 MENU_BAR_ITEMS_USED is the length of VECTOR.
873 VECTOR is an array of menu events for the whole menu. */
875 void
876 find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
878 Lisp_Object prefix, entry;
879 Lisp_Object *subprefix_stack;
880 int submenu_depth = 0;
881 int i;
883 entry = Qnil;
884 subprefix_stack = alloca (menu_bar_items_used * sizeof *subprefix_stack);
885 prefix = Qnil;
886 i = 0;
888 while (i < menu_bar_items_used)
890 if (EQ (AREF (vector, i), Qnil))
892 subprefix_stack[submenu_depth++] = prefix;
893 prefix = entry;
894 i++;
896 else if (EQ (AREF (vector, i), Qlambda))
898 prefix = subprefix_stack[--submenu_depth];
899 i++;
901 else if (EQ (AREF (vector, i), Qt))
903 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
904 i += MENU_ITEMS_PANE_LENGTH;
906 else
908 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
909 /* Treat the pointer as an integer. There's no problem
910 as long as pointers have enough bits to hold small integers. */
911 if ((intptr_t) client_data == i)
913 int j;
914 struct input_event buf;
915 Lisp_Object frame;
916 EVENT_INIT (buf);
918 XSETFRAME (frame, f);
919 buf.kind = MENU_BAR_EVENT;
920 buf.frame_or_window = frame;
921 buf.arg = frame;
922 kbd_buffer_store_event (&buf);
924 for (j = 0; j < submenu_depth; j++)
925 if (!NILP (subprefix_stack[j]))
927 buf.kind = MENU_BAR_EVENT;
928 buf.frame_or_window = frame;
929 buf.arg = subprefix_stack[j];
930 kbd_buffer_store_event (&buf);
933 if (!NILP (prefix))
935 buf.kind = MENU_BAR_EVENT;
936 buf.frame_or_window = frame;
937 buf.arg = prefix;
938 kbd_buffer_store_event (&buf);
941 buf.kind = MENU_BAR_EVENT;
942 buf.frame_or_window = frame;
943 buf.arg = entry;
944 kbd_buffer_store_event (&buf);
946 return;
948 i += MENU_ITEMS_ITEM_LENGTH;
953 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
955 #ifdef HAVE_NS
956 /* As above, but return the menu selection instead of storing in kb buffer.
957 If keymaps==1, return full prefixes to selection. */
958 Lisp_Object
959 find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
961 Lisp_Object prefix, entry;
962 int i;
963 Lisp_Object *subprefix_stack;
964 int submenu_depth = 0;
966 prefix = entry = Qnil;
967 i = 0;
968 subprefix_stack = alloca (menu_items_used * word_size);
970 while (i < menu_items_used)
972 if (EQ (AREF (menu_items, i), Qnil))
974 subprefix_stack[submenu_depth++] = prefix;
975 prefix = entry;
976 i++;
978 else if (EQ (AREF (menu_items, i), Qlambda))
980 prefix = subprefix_stack[--submenu_depth];
981 i++;
983 else if (EQ (AREF (menu_items, i), Qt))
985 prefix
986 = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
987 i += MENU_ITEMS_PANE_LENGTH;
989 /* Ignore a nil in the item list.
990 It's meaningful only for dialog boxes. */
991 else if (EQ (AREF (menu_items, i), Qquote))
992 i += 1;
993 else
995 entry
996 = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
997 if (aref_addr (menu_items, i) == client_data)
999 if (keymaps != 0)
1001 int j;
1003 entry = Fcons (entry, Qnil);
1004 if (!NILP (prefix))
1005 entry = Fcons (prefix, entry);
1006 for (j = submenu_depth - 1; j >= 0; j--)
1007 if (!NILP (subprefix_stack[j]))
1008 entry = Fcons (subprefix_stack[j], entry);
1010 return entry;
1012 i += MENU_ITEMS_ITEM_LENGTH;
1015 return Qnil;
1017 #endif /* HAVE_NS */
1019 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1020 doc: /* Pop up a deck-of-cards menu and return user's selection.
1021 POSITION is a position specification. This is either a mouse button event
1022 or a list ((XOFFSET YOFFSET) WINDOW)
1023 where XOFFSET and YOFFSET are positions in pixels from the top left
1024 corner of WINDOW. (WINDOW may be a window or a frame object.)
1025 This controls the position of the top left of the menu as a whole.
1026 If POSITION is t, it means to use the current mouse position.
1028 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1029 The menu items come from key bindings that have a menu string as well as
1030 a definition; actually, the "definition" in such a key binding looks like
1031 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1032 the keymap as a top-level element.
1034 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1035 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1037 You can also use a list of keymaps as MENU.
1038 Then each keymap makes a separate pane.
1040 When MENU is a keymap or a list of keymaps, the return value is the
1041 list of events corresponding to the user's choice. Note that
1042 `x-popup-menu' does not actually execute the command bound to that
1043 sequence of events.
1045 Alternatively, you can specify a menu of multiple panes
1046 with a list of the form (TITLE PANE1 PANE2...),
1047 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1048 Each ITEM is normally a cons cell (STRING . VALUE);
1049 but a string can appear as an item--that makes a nonselectable line
1050 in the menu.
1051 With this form of menu, the return value is VALUE from the chosen item.
1053 If POSITION is nil, don't display the menu at all, just precalculate the
1054 cached information about equivalent key sequences.
1056 If the user gets rid of the menu without making a valid choice, for
1057 instance by clicking the mouse away from a valid choice or by typing
1058 keyboard input, then this normally results in a quit and
1059 `x-popup-menu' does not return. But if POSITION is a mouse button
1060 event (indicating that the user invoked the menu with the mouse) then
1061 no quit occurs and `x-popup-menu' returns nil. */)
1062 (Lisp_Object position, Lisp_Object menu)
1064 Lisp_Object keymap, tem;
1065 int xpos = 0, ypos = 0;
1066 Lisp_Object title;
1067 const char *error_name = NULL;
1068 Lisp_Object selection = Qnil;
1069 FRAME_PTR f = NULL;
1070 Lisp_Object x, y, window;
1071 int keymaps = 0;
1072 int for_click = 0;
1073 ptrdiff_t specpdl_count = SPECPDL_INDEX ();
1074 struct gcpro gcpro1;
1076 if (NILP (position))
1077 /* This is an obsolete call, which wants us to precompute the
1078 keybinding equivalents, but we don't do that any more anyway. */
1079 return Qnil;
1081 #ifdef HAVE_MENUS
1083 int get_current_pos_p = 0;
1084 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1086 /* Decode the first argument: find the window and the coordinates. */
1087 if (EQ (position, Qt)
1088 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
1089 || EQ (XCAR (position), Qtool_bar))))
1091 get_current_pos_p = 1;
1093 else
1095 tem = Fcar (position);
1096 if (CONSP (tem))
1098 window = Fcar (Fcdr (position));
1099 x = XCAR (tem);
1100 y = Fcar (XCDR (tem));
1102 else
1104 for_click = 1;
1105 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1106 window = Fcar (tem); /* POSN_WINDOW (tem) */
1107 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1108 x = Fcar (tem);
1109 y = Fcdr (tem);
1112 /* If a click happens in an external tool bar or a detached
1113 tool bar, x and y is NIL. In that case, use the current
1114 mouse position. This happens for the help button in the
1115 tool bar. Ideally popup-menu should pass NIL to
1116 this function, but it doesn't. */
1117 if (NILP (x) && NILP (y))
1118 get_current_pos_p = 1;
1121 if (get_current_pos_p)
1123 /* Use the mouse's current position. */
1124 FRAME_PTR new_f = SELECTED_FRAME ();
1125 #ifdef HAVE_X_WINDOWS
1126 /* Can't use mouse_position_hook for X since it returns
1127 coordinates relative to the window the mouse is in,
1128 we need coordinates relative to the edit widget always. */
1129 if (new_f != 0)
1131 int cur_x, cur_y;
1133 mouse_position_for_popup (new_f, &cur_x, &cur_y);
1134 /* cur_x/y may be negative, so use make_number. */
1135 x = make_number (cur_x);
1136 y = make_number (cur_y);
1139 #else /* not HAVE_X_WINDOWS */
1140 Lisp_Object bar_window;
1141 enum scroll_bar_part part;
1142 Time time;
1143 void (*mouse_position_hook) (struct frame **, int,
1144 Lisp_Object *,
1145 enum scroll_bar_part *,
1146 Lisp_Object *,
1147 Lisp_Object *,
1148 Time *) =
1149 FRAME_TERMINAL (new_f)->mouse_position_hook;
1151 if (mouse_position_hook)
1152 (*mouse_position_hook) (&new_f, 1, &bar_window,
1153 &part, &x, &y, &time);
1154 #endif /* not HAVE_X_WINDOWS */
1156 if (new_f != 0)
1157 XSETFRAME (window, new_f);
1158 else
1160 window = selected_window;
1161 XSETFASTINT (x, 0);
1162 XSETFASTINT (y, 0);
1166 /* Decode where to put the menu. */
1168 if (FRAMEP (window))
1170 f = XFRAME (window);
1171 xpos = 0;
1172 ypos = 0;
1174 else if (WINDOWP (window))
1176 struct window *win = XWINDOW (window);
1177 CHECK_LIVE_WINDOW (window);
1178 f = XFRAME (WINDOW_FRAME (win));
1180 xpos = WINDOW_LEFT_EDGE_X (win);
1181 ypos = WINDOW_TOP_EDGE_Y (win);
1183 else
1184 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1185 but I don't want to make one now. */
1186 CHECK_WINDOW (window);
1188 CHECK_RANGED_INTEGER (x,
1189 (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM
1190 ? (EMACS_INT) INT_MIN - xpos
1191 : MOST_NEGATIVE_FIXNUM),
1192 INT_MAX - xpos);
1193 CHECK_RANGED_INTEGER (y,
1194 (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM
1195 ? (EMACS_INT) INT_MIN - ypos
1196 : MOST_NEGATIVE_FIXNUM),
1197 INT_MAX - ypos);
1198 xpos += XINT (x);
1199 ypos += XINT (y);
1201 /* FIXME: Find a more general check! */
1202 if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
1203 || FRAME_W32_P (f) || FRAME_NS_P (f)))
1204 error ("Can not put GUI menu on this terminal");
1206 XSETFRAME (Vmenu_updating_frame, f);
1208 #endif /* HAVE_MENUS */
1210 /* Now parse the lisp menus. */
1211 record_unwind_protect (unuse_menu_items, Qnil);
1213 title = Qnil;
1214 GCPRO1 (title);
1216 /* Decode the menu items from what was specified. */
1218 keymap = get_keymap (menu, 0, 0);
1219 if (CONSP (keymap))
1221 /* We were given a keymap. Extract menu info from the keymap. */
1222 Lisp_Object prompt;
1224 /* Extract the detailed info to make one pane. */
1225 keymap_panes (&menu, 1);
1227 /* Search for a string appearing directly as an element of the keymap.
1228 That string is the title of the menu. */
1229 prompt = Fkeymap_prompt (keymap);
1230 if (!NILP (prompt))
1231 title = prompt;
1232 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1233 else
1234 title = build_string ("Select");
1235 #endif
1237 /* Make that be the pane title of the first pane. */
1238 if (!NILP (prompt) && menu_items_n_panes >= 0)
1239 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
1241 keymaps = 1;
1243 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
1245 /* We were given a list of keymaps. */
1246 EMACS_INT nmaps = XFASTINT (Flength (menu));
1247 Lisp_Object *maps;
1248 ptrdiff_t i;
1249 USE_SAFE_ALLOCA;
1251 SAFE_ALLOCA_LISP (maps, nmaps);
1252 title = Qnil;
1254 /* The first keymap that has a prompt string
1255 supplies the menu title. */
1256 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
1258 Lisp_Object prompt;
1260 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
1262 prompt = Fkeymap_prompt (keymap);
1263 if (NILP (title) && !NILP (prompt))
1264 title = prompt;
1267 /* Extract the detailed info to make one pane. */
1268 keymap_panes (maps, nmaps);
1270 /* Make the title be the pane title of the first pane. */
1271 if (!NILP (title) && menu_items_n_panes >= 0)
1272 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
1274 keymaps = 1;
1276 SAFE_FREE ();
1278 else
1280 /* We were given an old-fashioned menu. */
1281 title = Fcar (menu);
1282 CHECK_STRING (title);
1284 list_of_panes (Fcdr (menu));
1286 keymaps = 0;
1289 unbind_to (specpdl_count, Qnil);
1291 #ifdef HAVE_MENUS
1292 #ifdef HAVE_WINDOW_SYSTEM
1293 /* Hide a previous tip, if any. */
1294 Fx_hide_tip ();
1295 #endif
1297 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1298 /* If resources from a previous popup menu still exist, does nothing
1299 until the `menu_free_timer' has freed them (see w32fns.c). This
1300 can occur if you press ESC or click outside a menu without selecting
1301 a menu item.
1303 if (current_popup_menu)
1305 discard_menu_items ();
1306 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1307 UNGCPRO;
1308 return Qnil;
1310 #endif
1312 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1313 record_unwind_protect (cleanup_popup_menu, Qnil);
1314 #endif
1316 /* Display them in a menu. */
1317 BLOCK_INPUT;
1319 /* FIXME: Use a terminal hook! */
1320 #if defined HAVE_NTGUI
1321 selection = w32_menu_show (f, xpos, ypos, for_click,
1322 keymaps, title, &error_name);
1323 #elif defined HAVE_NS
1324 selection = ns_menu_show (f, xpos, ypos, for_click,
1325 keymaps, title, &error_name);
1326 #else /* MSDOS and X11 */
1327 /* Assume last_event_timestamp is the timestamp of the button event.
1328 Is this assumption ever violated? We can't use the timestamp
1329 stored within POSITION because there the top bits from the actual
1330 timestamp may be truncated away (Bug#4930). */
1331 selection = xmenu_show (f, xpos, ypos, for_click,
1332 keymaps, title, &error_name,
1333 last_event_timestamp);
1334 #endif
1336 UNBLOCK_INPUT;
1338 #ifdef HAVE_NS
1339 unbind_to (specpdl_count, Qnil);
1340 #else
1341 discard_menu_items ();
1342 #endif
1344 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1345 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1346 #endif
1348 #endif /* HAVE_MENUS */
1350 UNGCPRO;
1352 if (error_name) error ("%s", error_name);
1353 return selection;
1356 void
1357 syms_of_menu (void)
1359 staticpro (&menu_items);
1360 menu_items = Qnil;
1361 menu_items_inuse = Qnil;
1363 defsubr (&Sx_popup_menu);