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/>. */
24 #include <limits.h> /* for INT_MAX */
31 #include "termhooks.h"
32 #include "blockinput.h"
33 #include "dispextern.h"
36 #include "../lwlib/lwlib.h"
54 extern AppendMenuW_Proc unicode_append_menu
;
55 extern HMENU current_popup_menu
;
57 #endif /* HAVE_NTGUI */
61 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
62 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
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 #if ! (defined USE_GTK || defined USE_MOTIF)
73 Lisp_Object menu_items_inuse
;
75 /* Number of slots currently allocated in menu_items. */
76 int menu_items_allocated
;
78 /* This is the index in menu_items of the first empty slot. */
81 /* The number of panes currently recorded in menu_items,
82 excluding those within submenus. */
83 int menu_items_n_panes
;
85 /* Current depth within submenus. */
86 static int menu_items_submenu_depth
;
89 init_menu_items (void)
91 if (!NILP (menu_items_inuse
))
92 error ("Trying to use a menu from within a menu-entry");
94 if (NILP (menu_items
))
96 menu_items_allocated
= 60;
97 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
100 menu_items_inuse
= Qt
;
102 menu_items_n_panes
= 0;
103 menu_items_submenu_depth
= 0;
106 /* Call at the end of generating the data in menu_items. */
109 finish_menu_items (void)
114 unuse_menu_items (Lisp_Object dummy
)
116 return menu_items_inuse
= Qnil
;
119 /* Call when finished using the data for the current menu
123 discard_menu_items (void)
125 /* Free the structure if it is especially large.
126 Otherwise, hold on to it, to save time. */
127 if (menu_items_allocated
> 200)
130 menu_items_allocated
= 0;
132 eassert (NILP (menu_items_inuse
));
137 cleanup_popup_menu (Lisp_Object arg
)
139 discard_menu_items ();
144 /* This undoes save_menu_items, and it is called by the specpdl unwind
148 restore_menu_items (Lisp_Object saved
)
150 menu_items
= XCAR (saved
);
151 menu_items_inuse
= (! NILP (menu_items
) ? Qt
: Qnil
);
152 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
153 saved
= XCDR (saved
);
154 menu_items_used
= XINT (XCAR (saved
));
155 saved
= XCDR (saved
);
156 menu_items_n_panes
= XINT (XCAR (saved
));
157 saved
= XCDR (saved
);
158 menu_items_submenu_depth
= XINT (XCAR (saved
));
162 /* Push the whole state of menu_items processing onto the specpdl.
163 It will be restored when the specpdl is unwound. */
166 save_menu_items (void)
168 Lisp_Object saved
= list4 (!NILP (menu_items_inuse
) ? menu_items
: Qnil
,
169 make_number (menu_items_used
),
170 make_number (menu_items_n_panes
),
171 make_number (menu_items_submenu_depth
));
172 record_unwind_protect (restore_menu_items
, saved
);
173 menu_items_inuse
= Qnil
;
178 /* Ensure that there is room for ITEMS items in the menu_items vector. */
181 ensure_menu_items (int items
)
183 int incr
= items
- (menu_items_allocated
- menu_items_used
);
186 menu_items
= larger_vector (menu_items
, incr
, INT_MAX
);
187 menu_items_allocated
= ASIZE (menu_items
);
191 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
192 || defined HAVE_NTGUI)
194 /* Begin a submenu. */
197 push_submenu_start (void)
199 ensure_menu_items (1);
200 ASET (menu_items
, menu_items_used
, Qnil
);
202 menu_items_submenu_depth
++;
208 push_submenu_end (void)
210 ensure_menu_items (1);
211 ASET (menu_items
, menu_items_used
, Qlambda
);
213 menu_items_submenu_depth
--;
216 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
218 /* Indicate boundary between left and right. */
221 push_left_right_boundary (void)
223 ensure_menu_items (1);
224 ASET (menu_items
, menu_items_used
, Qquote
);
228 /* Start a new menu pane in menu_items.
229 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
232 push_menu_pane (Lisp_Object name
, Lisp_Object prefix_vec
)
234 ensure_menu_items (MENU_ITEMS_PANE_LENGTH
);
235 if (menu_items_submenu_depth
== 0)
236 menu_items_n_panes
++;
237 ASET (menu_items
, menu_items_used
, Qt
);
239 ASET (menu_items
, menu_items_used
, name
);
241 ASET (menu_items
, menu_items_used
, prefix_vec
);
245 /* Push one menu item into the current pane. NAME is the string to
246 display. ENABLE if non-nil means this item can be selected. KEY
247 is the key generated by choosing this item, or nil if this item
248 doesn't really have a definition. DEF is the definition of this
249 item. EQUIV is the textual description of the keyboard equivalent
250 for this item (or nil if none). TYPE is the type of this menu
251 item, one of nil, `toggle' or `radio'. */
254 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
)
256 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH
);
258 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_NAME
, name
);
259 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_ENABLE
, enable
);
260 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_VALUE
, key
);
261 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_EQUIV_KEY
, equiv
);
262 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_DEFINITION
, def
);
263 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_TYPE
, type
);
264 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_SELECTED
, selected
);
265 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_HELP
, help
);
267 menu_items_used
+= MENU_ITEMS_ITEM_LENGTH
;
270 /* Args passed between single_keymap_panes and single_menu_item. */
273 Lisp_Object pending_maps
;
278 static void single_menu_item (Lisp_Object
, Lisp_Object
, Lisp_Object
,
281 /* This is a recursive subroutine of keymap_panes.
282 It handles one keymap, KEYMAP.
283 The other arguments are passed along
284 or point to local variables of the previous function.
286 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
289 single_keymap_panes (Lisp_Object keymap
, Lisp_Object pane_name
,
290 Lisp_Object prefix
, int maxdepth
)
295 skp
.pending_maps
= Qnil
;
296 skp
.maxdepth
= maxdepth
;
302 push_menu_pane (pane_name
, prefix
);
305 /* Remember index for first item in this pane so we can go back and
306 add a prefix when (if) we see the first button. After that, notbuttons
307 is set to 0, to mark that we have seen a button and all non button
308 items need a prefix. */
309 skp
.notbuttons
= menu_items_used
;
312 GCPRO1 (skp
.pending_maps
);
313 map_keymap_canonical (keymap
, single_menu_item
, Qnil
, &skp
);
316 /* Process now any submenus which want to be panes at this level. */
317 while (CONSP (skp
.pending_maps
))
319 Lisp_Object elt
, eltcdr
, string
;
320 elt
= XCAR (skp
.pending_maps
);
322 string
= XCAR (eltcdr
);
323 /* We no longer discard the @ from the beginning of the string here.
324 Instead, we do this in *menu_show. */
325 single_keymap_panes (Fcar (elt
), string
, XCDR (eltcdr
), maxdepth
- 1);
326 skp
.pending_maps
= XCDR (skp
.pending_maps
);
330 /* This is a subroutine of single_keymap_panes that handles one
332 KEY is a key in a keymap and ITEM is its binding.
333 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
335 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
338 single_menu_item (Lisp_Object key
, Lisp_Object item
, Lisp_Object dummy
, void *skp_v
)
340 Lisp_Object map
, item_string
, enabled
;
341 struct gcpro gcpro1
, gcpro2
;
343 struct skp
*skp
= skp_v
;
345 /* Parse the menu item and leave the result in item_properties. */
347 res
= parse_menu_item (item
, 0);
350 return; /* Not a menu item. */
352 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
354 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
355 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
357 if (!NILP (map
) && SREF (item_string
, 0) == '@')
360 /* An enabled separate pane. Remember this to handle it later. */
361 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
366 #if defined (HAVE_X_WINDOWS) || defined (MSDOS)
368 /* Simulate radio buttons and toggle boxes by putting a prefix in
371 Lisp_Object prefix
= Qnil
;
372 Lisp_Object type
= AREF (item_properties
, ITEM_PROPERTY_TYPE
);
376 = AREF (item_properties
, ITEM_PROPERTY_SELECTED
);
379 /* The first button. Line up previous items in this menu. */
381 int idx
= skp
->notbuttons
; /* Index for first item this menu. */
384 while (idx
< menu_items_used
)
387 = AREF (menu_items
, idx
+ MENU_ITEMS_ITEM_NAME
);
391 submenu
++; /* Skip sub menu. */
393 else if (EQ (tem
, Qlambda
))
396 submenu
--; /* End sub menu. */
398 else if (EQ (tem
, Qt
))
399 idx
+= 3; /* Skip new pane marker. */
400 else if (EQ (tem
, Qquote
))
401 idx
++; /* Skip a left, right divider. */
404 if (!submenu
&& SREF (tem
, 0) != '\0'
405 && SREF (tem
, 0) != '-')
406 ASET (menu_items
, idx
+ MENU_ITEMS_ITEM_NAME
,
407 concat2 (build_string (" "), tem
));
408 idx
+= MENU_ITEMS_ITEM_LENGTH
;
414 /* Calculate prefix, if any, for this item. */
415 if (EQ (type
, QCtoggle
))
416 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
417 else if (EQ (type
, QCradio
))
418 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
420 /* Not a button. If we have earlier buttons, then we need a prefix. */
421 else if (!skp
->notbuttons
&& SREF (item_string
, 0) != '\0'
422 && SREF (item_string
, 0) != '-')
423 prefix
= build_string (" ");
426 item_string
= concat2 (prefix
, item_string
);
428 #endif /* not HAVE_BOXES */
430 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
432 /* Indicate visually that this is a submenu. */
433 item_string
= concat2 (item_string
, build_string (" >"));
436 #endif /* HAVE_X_WINDOWS || MSDOS */
438 push_menu_item (item_string
, enabled
, key
,
439 AREF (item_properties
, ITEM_PROPERTY_DEF
),
440 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
441 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
442 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
443 AREF (item_properties
, ITEM_PROPERTY_HELP
));
445 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
446 /* Display a submenu using the toolkit. */
447 if (! (NILP (map
) || NILP (enabled
)))
449 push_submenu_start ();
450 single_keymap_panes (map
, Qnil
, key
, skp
->maxdepth
- 1);
456 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
457 and generate menu panes for them in menu_items. */
460 keymap_panes (Lisp_Object
*keymaps
, ptrdiff_t nmaps
)
466 /* Loop over the given keymaps, making a pane for each map.
467 But don't make a pane that is empty--ignore that map instead.
468 P is the number of panes we have made so far. */
469 for (mapno
= 0; mapno
< nmaps
; mapno
++)
470 single_keymap_panes (keymaps
[mapno
],
471 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, 10);
473 finish_menu_items ();
477 /* Push the items in a single pane defined by the alist PANE. */
479 list_of_items (Lisp_Object pane
)
481 Lisp_Object tail
, item
, item1
;
483 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
487 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
488 Qnil
, Qnil
, Qnil
, Qnil
);
489 else if (CONSP (item
))
492 CHECK_STRING (item1
);
493 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
494 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
497 push_left_right_boundary ();
502 /* Push all the panes and items of a menu described by the
503 alist-of-alists MENU.
504 This handles old-fashioned calls to x-popup-menu. */
506 list_of_panes (Lisp_Object menu
)
512 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
514 Lisp_Object elt
, pane_name
, pane_data
;
516 pane_name
= Fcar (elt
);
517 CHECK_STRING (pane_name
);
518 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
519 pane_data
= Fcdr (elt
);
520 CHECK_CONS (pane_data
);
521 list_of_items (pane_data
);
524 finish_menu_items ();
527 /* Set up data in menu_items for a menu bar item
528 whose event type is ITEM_KEY (with string ITEM_NAME)
529 and whose contents come from the list of keymaps MAPS. */
531 parse_single_submenu (Lisp_Object item_key
, Lisp_Object item_name
, Lisp_Object maps
)
537 int top_level_items
= 0;
540 length
= Flength (maps
);
543 /* Convert the list MAPS into a vector MAPVEC. */
544 SAFE_ALLOCA_LISP (mapvec
, len
);
545 for (i
= 0; i
< len
; i
++)
547 mapvec
[i
] = Fcar (maps
);
551 /* Loop over the given keymaps, making a pane for each map.
552 But don't make a pane that is empty--ignore that map instead. */
553 for (i
= 0; i
< len
; i
++)
555 if (!KEYMAPP (mapvec
[i
]))
557 /* Here we have a command at top level in the menu bar
558 as opposed to a submenu. */
560 push_menu_pane (Qnil
, Qnil
);
561 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
562 Qnil
, Qnil
, Qnil
, Qnil
);
567 prompt
= Fkeymap_prompt (mapvec
[i
]);
568 single_keymap_panes (mapvec
[i
],
569 !NILP (prompt
) ? prompt
: item_name
,
575 return top_level_items
;
579 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
581 /* Allocate a widget_value, blocking input. */
584 xmalloc_widget_value (void)
589 value
= malloc_widget_value ();
595 /* This recursively calls free_widget_value on the tree of widgets.
596 It must free all data that was malloc'ed for these widget_values.
597 In Emacs, many slots are pointers into the data of Lisp_Strings, and
598 must be left alone. */
601 free_menubar_widget_value_tree (widget_value
*wv
)
605 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
607 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
609 free_menubar_widget_value_tree (wv
->contents
);
610 wv
->contents
= (widget_value
*) 0xDEADBEEF;
614 free_menubar_widget_value_tree (wv
->next
);
615 wv
->next
= (widget_value
*) 0xDEADBEEF;
618 free_widget_value (wv
);
622 /* Create a tree of widget_value objects
623 representing the panes and items
624 in menu_items starting at index START, up to index END. */
627 digest_single_submenu (int start
, int end
, int top_level_items
)
629 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
631 int submenu_depth
= 0;
632 widget_value
**submenu_stack
;
636 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
637 wv
= xmalloc_widget_value ();
641 wv
->button_type
= BUTTON_TYPE_NONE
;
647 /* Loop over all panes and items made by the preceding call
648 to parse_single_submenu and construct a tree of widget_value objects.
649 Ignore the panes and items used by previous calls to
650 digest_single_submenu, even though those are also in menu_items. */
654 if (EQ (AREF (menu_items
, i
), Qnil
))
656 submenu_stack
[submenu_depth
++] = save_wv
;
661 else if (EQ (AREF (menu_items
, i
), Qlambda
))
664 save_wv
= submenu_stack
[--submenu_depth
];
667 else if (EQ (AREF (menu_items
, i
), Qt
)
668 && submenu_depth
!= 0)
669 i
+= MENU_ITEMS_PANE_LENGTH
;
670 /* Ignore a nil in the item list.
671 It's meaningful only for dialog boxes. */
672 else if (EQ (AREF (menu_items
, i
), Qquote
))
674 else if (EQ (AREF (menu_items
, i
), Qt
))
676 /* Create a new pane. */
677 Lisp_Object pane_name
;
678 const char *pane_string
;
682 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
685 if (STRINGP (pane_name
))
687 if (unicode_append_menu
)
688 /* Encode as UTF-8 for now. */
689 pane_name
= ENCODE_UTF_8 (pane_name
);
690 else if (STRING_MULTIBYTE (pane_name
))
691 pane_name
= ENCODE_SYSTEM (pane_name
);
693 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
695 #elif defined (USE_LUCID) && defined (HAVE_XFT)
696 if (STRINGP (pane_name
))
698 pane_name
= ENCODE_UTF_8 (pane_name
);
699 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
701 #elif !defined (HAVE_MULTILINGUAL_MENU)
702 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
704 pane_name
= ENCODE_MENU_STRING (pane_name
);
705 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
709 pane_string
= (NILP (pane_name
)
710 ? "" : SSDATA (pane_name
));
711 /* If there is just one top-level pane, put all its items directly
712 under the top-level menu. */
713 if (menu_items_n_panes
== 1)
716 /* If the pane has a meaningful name,
717 make the pane a top-level menu item
718 with its items as a submenu beneath it. */
719 if (strcmp (pane_string
, ""))
721 wv
= xmalloc_widget_value ();
725 first_wv
->contents
= wv
;
726 wv
->lname
= pane_name
;
727 /* Set value to 1 so update_submenu_strings can handle '@' */
728 wv
->value
= (char *)1;
730 wv
->button_type
= BUTTON_TYPE_NONE
;
738 i
+= MENU_ITEMS_PANE_LENGTH
;
742 /* Create a new item within current pane. */
743 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
746 /* All items should be contained in panes. */
750 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
751 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
752 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
753 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
754 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
755 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
756 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
759 if (STRINGP (item_name
))
761 if (unicode_append_menu
)
762 item_name
= ENCODE_UTF_8 (item_name
);
763 else if (STRING_MULTIBYTE (item_name
))
764 item_name
= ENCODE_SYSTEM (item_name
);
766 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
769 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
771 descrip
= ENCODE_SYSTEM (descrip
);
772 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
775 if (STRINGP (item_name
))
777 item_name
= ENCODE_UTF_8 (item_name
);
778 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
781 if (STRINGP (descrip
))
783 descrip
= ENCODE_UTF_8 (descrip
);
784 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
786 #elif !defined (HAVE_MULTILINGUAL_MENU)
787 if (STRING_MULTIBYTE (item_name
))
789 item_name
= ENCODE_MENU_STRING (item_name
);
790 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
793 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
795 descrip
= ENCODE_MENU_STRING (descrip
);
796 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
800 wv
= xmalloc_widget_value ();
804 save_wv
->contents
= wv
;
806 wv
->lname
= item_name
;
810 /* The intptr_t cast avoids a warning. There's no problem
811 as long as pointers have enough bits to hold small integers. */
812 wv
->call_data
= (!NILP (def
) ? (void *) (intptr_t) i
: 0);
813 wv
->enabled
= !NILP (enable
);
816 wv
->button_type
= BUTTON_TYPE_NONE
;
817 else if (EQ (type
, QCradio
))
818 wv
->button_type
= BUTTON_TYPE_RADIO
;
819 else if (EQ (type
, QCtoggle
))
820 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
824 wv
->selected
= !NILP (selected
);
825 if (! STRINGP (help
))
832 i
+= MENU_ITEMS_ITEM_LENGTH
;
836 /* If we have just one "menu item"
837 that was originally a button, return it by itself. */
838 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
840 wv
= first_wv
->contents
;
841 free_widget_value (first_wv
);
848 /* Walk through the widget_value tree starting at FIRST_WV and update
849 the char * pointers from the corresponding lisp values.
850 We do this after building the whole tree, since GC may happen while the
851 tree is constructed, and small strings are relocated. So we must wait
852 until no GC can happen before storing pointers into lisp values. */
854 update_submenu_strings (widget_value
*first_wv
)
858 for (wv
= first_wv
; wv
; wv
= wv
->next
)
860 if (STRINGP (wv
->lname
))
862 wv
->name
= SSDATA (wv
->lname
);
864 /* Ignore the @ that means "separate pane".
865 This is a kludge, but this isn't worth more time. */
866 if (wv
->value
== (char *)1)
868 if (wv
->name
[0] == '@')
874 if (STRINGP (wv
->lkey
))
875 wv
->key
= SSDATA (wv
->lkey
);
878 update_submenu_strings (wv
->contents
);
882 /* Find the menu selection and store it in the keyboard buffer.
883 F is the frame the menu is on.
884 MENU_BAR_ITEMS_USED is the length of VECTOR.
885 VECTOR is an array of menu events for the whole menu. */
888 find_and_call_menu_selection (FRAME_PTR f
, int menu_bar_items_used
, Lisp_Object vector
, void *client_data
)
890 Lisp_Object prefix
, entry
;
891 Lisp_Object
*subprefix_stack
;
892 int submenu_depth
= 0;
896 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
900 while (i
< menu_bar_items_used
)
902 if (EQ (AREF (vector
, i
), Qnil
))
904 subprefix_stack
[submenu_depth
++] = prefix
;
908 else if (EQ (AREF (vector
, i
), Qlambda
))
910 prefix
= subprefix_stack
[--submenu_depth
];
913 else if (EQ (AREF (vector
, i
), Qt
))
915 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
916 i
+= MENU_ITEMS_PANE_LENGTH
;
920 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
921 /* Treat the pointer as an integer. There's no problem
922 as long as pointers have enough bits to hold small integers. */
923 if ((intptr_t) client_data
== i
)
926 struct input_event buf
;
930 XSETFRAME (frame
, f
);
931 buf
.kind
= MENU_BAR_EVENT
;
932 buf
.frame_or_window
= frame
;
934 kbd_buffer_store_event (&buf
);
936 for (j
= 0; j
< submenu_depth
; j
++)
937 if (!NILP (subprefix_stack
[j
]))
939 buf
.kind
= MENU_BAR_EVENT
;
940 buf
.frame_or_window
= frame
;
941 buf
.arg
= subprefix_stack
[j
];
942 kbd_buffer_store_event (&buf
);
947 buf
.kind
= MENU_BAR_EVENT
;
948 buf
.frame_or_window
= frame
;
950 kbd_buffer_store_event (&buf
);
953 buf
.kind
= MENU_BAR_EVENT
;
954 buf
.frame_or_window
= frame
;
956 kbd_buffer_store_event (&buf
);
960 i
+= MENU_ITEMS_ITEM_LENGTH
;
965 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
968 /* As above, but return the menu selection instead of storing in kb buffer.
969 If keymaps==1, return full prefixes to selection. */
971 find_and_return_menu_selection (FRAME_PTR f
, int keymaps
, void *client_data
)
973 Lisp_Object prefix
, entry
;
975 Lisp_Object
*subprefix_stack
;
976 int submenu_depth
= 0;
978 prefix
= entry
= Qnil
;
981 (Lisp_Object
*)alloca (menu_items_used
* sizeof (Lisp_Object
));
983 while (i
< menu_items_used
)
985 if (EQ (AREF (menu_items
, i
), Qnil
))
987 subprefix_stack
[submenu_depth
++] = prefix
;
991 else if (EQ (AREF (menu_items
, i
), Qlambda
))
993 prefix
= subprefix_stack
[--submenu_depth
];
996 else if (EQ (AREF (menu_items
, i
), Qt
))
999 = AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1000 i
+= MENU_ITEMS_PANE_LENGTH
;
1002 /* Ignore a nil in the item list.
1003 It's meaningful only for dialog boxes. */
1004 else if (EQ (AREF (menu_items
, i
), Qquote
))
1009 = AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1010 if (&AREF (menu_items
, i
) == client_data
)
1016 entry
= Fcons (entry
, Qnil
);
1018 entry
= Fcons (prefix
, entry
);
1019 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1020 if (!NILP (subprefix_stack
[j
]))
1021 entry
= Fcons (subprefix_stack
[j
], entry
);
1025 i
+= MENU_ITEMS_ITEM_LENGTH
;
1030 #endif /* HAVE_NS */
1032 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
1033 doc
: /* Pop up a deck-of-cards menu and return user's selection.
1034 POSITION is a position specification. This is either a mouse button event
1035 or a list ((XOFFSET YOFFSET) WINDOW)
1036 where XOFFSET and YOFFSET are positions in pixels from the top left
1037 corner of WINDOW. (WINDOW may be a window or a frame object.)
1038 This controls the position of the top left of the menu as a whole.
1039 If POSITION is t, it means to use the current mouse position.
1041 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1042 The menu items come from key bindings that have a menu string as well as
1043 a definition; actually, the "definition" in such a key binding looks like
1044 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1045 the keymap as a top-level element.
1047 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1048 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1050 You can also use a list of keymaps as MENU.
1051 Then each keymap makes a separate pane.
1053 When MENU is a keymap or a list of keymaps, the return value is the
1054 list of events corresponding to the user's choice. Note that
1055 `x-popup-menu' does not actually execute the command bound to that
1058 Alternatively, you can specify a menu of multiple panes
1059 with a list of the form (TITLE PANE1 PANE2...),
1060 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1061 Each ITEM is normally a cons cell (STRING . VALUE);
1062 but a string can appear as an item--that makes a nonselectable line
1064 With this form of menu, the return value is VALUE from the chosen item.
1066 If POSITION is nil, don't display the menu at all, just precalculate the
1067 cached information about equivalent key sequences.
1069 If the user gets rid of the menu without making a valid choice, for
1070 instance by clicking the mouse away from a valid choice or by typing
1071 keyboard input, then this normally results in a quit and
1072 `x-popup-menu' does not return. But if POSITION is a mouse button
1073 event (indicating that the user invoked the menu with the mouse) then
1074 no quit occurs and `x-popup-menu' returns nil. */)
1075 (Lisp_Object position
, Lisp_Object menu
)
1077 Lisp_Object keymap
, tem
;
1078 int xpos
= 0, ypos
= 0;
1080 const char *error_name
= NULL
;
1081 Lisp_Object selection
= Qnil
;
1083 Lisp_Object x
, y
, window
;
1086 ptrdiff_t specpdl_count
= SPECPDL_INDEX ();
1087 struct gcpro gcpro1
;
1089 if (NILP (position
))
1090 /* This is an obsolete call, which wants us to precompute the
1091 keybinding equivalents, but we don't do that any more anyway. */
1096 int get_current_pos_p
= 0;
1097 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1099 /* Decode the first argument: find the window and the coordinates. */
1100 if (EQ (position
, Qt
)
1101 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
1102 || EQ (XCAR (position
), Qtool_bar
))))
1104 get_current_pos_p
= 1;
1108 tem
= Fcar (position
);
1111 window
= Fcar (Fcdr (position
));
1113 y
= Fcar (XCDR (tem
));
1118 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1119 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1120 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
1125 /* If a click happens in an external tool bar or a detached
1126 tool bar, x and y is NIL. In that case, use the current
1127 mouse position. This happens for the help button in the
1128 tool bar. Ideally popup-menu should pass NIL to
1129 this function, but it doesn't. */
1130 if (NILP (x
) && NILP (y
))
1131 get_current_pos_p
= 1;
1134 if (get_current_pos_p
)
1136 /* Use the mouse's current position. */
1137 FRAME_PTR new_f
= SELECTED_FRAME ();
1138 #ifdef HAVE_X_WINDOWS
1139 /* Can't use mouse_position_hook for X since it returns
1140 coordinates relative to the window the mouse is in,
1141 we need coordinates relative to the edit widget always. */
1146 mouse_position_for_popup (new_f
, &cur_x
, &cur_y
);
1147 /* cur_x/y may be negative, so use make_number. */
1148 x
= make_number (cur_x
);
1149 y
= make_number (cur_y
);
1152 #else /* not HAVE_X_WINDOWS */
1153 Lisp_Object bar_window
;
1154 enum scroll_bar_part part
;
1156 void (*mouse_position_hook
) (struct frame
**, int,
1158 enum scroll_bar_part
*,
1162 FRAME_TERMINAL (new_f
)->mouse_position_hook
;
1164 if (mouse_position_hook
)
1165 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
1166 &part
, &x
, &y
, &time
);
1167 #endif /* not HAVE_X_WINDOWS */
1170 XSETFRAME (window
, new_f
);
1173 window
= selected_window
;
1179 /* Decode where to put the menu. */
1181 if (FRAMEP (window
))
1183 f
= XFRAME (window
);
1187 else if (WINDOWP (window
))
1189 struct window
*win
= XWINDOW (window
);
1190 CHECK_LIVE_WINDOW (window
);
1191 f
= XFRAME (WINDOW_FRAME (win
));
1193 xpos
= WINDOW_LEFT_EDGE_X (win
);
1194 ypos
= WINDOW_TOP_EDGE_Y (win
);
1197 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1198 but I don't want to make one now. */
1199 CHECK_WINDOW (window
);
1201 CHECK_RANGED_INTEGER ((xpos
< INT_MIN
- MOST_NEGATIVE_FIXNUM
1202 ? (EMACS_INT
) INT_MIN
- xpos
1203 : MOST_NEGATIVE_FIXNUM
),
1205 CHECK_RANGED_INTEGER ((ypos
< INT_MIN
- MOST_NEGATIVE_FIXNUM
1206 ? (EMACS_INT
) INT_MIN
- ypos
1207 : MOST_NEGATIVE_FIXNUM
),
1212 /* FIXME: Find a more general check! */
1213 if (!(FRAME_X_P (f
) || FRAME_MSDOS_P (f
)
1214 || FRAME_W32_P (f
) || FRAME_NS_P (f
)))
1215 error ("Can not put GUI menu on this terminal");
1217 XSETFRAME (Vmenu_updating_frame
, f
);
1219 #endif /* HAVE_MENUS */
1221 /* Now parse the lisp menus. */
1222 record_unwind_protect (unuse_menu_items
, Qnil
);
1227 /* Decode the menu items from what was specified. */
1229 keymap
= get_keymap (menu
, 0, 0);
1232 /* We were given a keymap. Extract menu info from the keymap. */
1235 /* Extract the detailed info to make one pane. */
1236 keymap_panes (&menu
, 1);
1238 /* Search for a string appearing directly as an element of the keymap.
1239 That string is the title of the menu. */
1240 prompt
= Fkeymap_prompt (keymap
);
1243 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1245 title
= build_string ("Select");
1248 /* Make that be the pane title of the first pane. */
1249 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
1250 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
1254 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
1256 /* We were given a list of keymaps. */
1257 EMACS_INT nmaps
= XFASTINT (Flength (menu
));
1262 SAFE_ALLOCA_LISP (maps
, nmaps
);
1265 /* The first keymap that has a prompt string
1266 supplies the menu title. */
1267 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
1271 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
1273 prompt
= Fkeymap_prompt (keymap
);
1274 if (NILP (title
) && !NILP (prompt
))
1278 /* Extract the detailed info to make one pane. */
1279 keymap_panes (maps
, nmaps
);
1281 /* Make the title be the pane title of the first pane. */
1282 if (!NILP (title
) && menu_items_n_panes
>= 0)
1283 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
1291 /* We were given an old-fashioned menu. */
1292 title
= Fcar (menu
);
1293 CHECK_STRING (title
);
1295 list_of_panes (Fcdr (menu
));
1300 unbind_to (specpdl_count
, Qnil
);
1303 #ifdef HAVE_WINDOW_SYSTEM
1304 /* Hide a previous tip, if any. */
1308 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1309 /* If resources from a previous popup menu still exist, does nothing
1310 until the `menu_free_timer' has freed them (see w32fns.c). This
1311 can occur if you press ESC or click outside a menu without selecting
1314 if (current_popup_menu
)
1316 discard_menu_items ();
1317 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1323 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1324 record_unwind_protect (cleanup_popup_menu
, Qnil
);
1327 /* Display them in a menu. */
1330 /* FIXME: Use a terminal hook! */
1331 #if defined HAVE_NTGUI
1332 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
1333 keymaps
, title
, &error_name
);
1334 #elif defined HAVE_NS
1335 selection
= ns_menu_show (f
, xpos
, ypos
, for_click
,
1336 keymaps
, title
, &error_name
);
1337 #else /* MSDOS and X11 */
1338 /* Assume last_event_timestamp is the timestamp of the button event.
1339 Is this assumption ever violated? We can't use the timestamp
1340 stored within POSITION because there the top bits from the actual
1341 timestamp may be truncated away (Bug#4930). */
1342 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
1343 keymaps
, title
, &error_name
,
1344 last_event_timestamp
);
1350 unbind_to (specpdl_count
, Qnil
);
1352 discard_menu_items ();
1355 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1356 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1359 #endif /* HAVE_MENUS */
1363 if (error_name
) error ("%s", error_name
);
1370 staticpro (&menu_items
);
1372 menu_items_inuse
= Qnil
;
1374 defsubr (&Sx_popup_menu
);