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/>. */
23 #include <limits.h> /* for INT_MAX */
30 #include "termhooks.h"
31 #include "blockinput.h"
32 #include "dispextern.h"
35 #include "../lwlib/lwlib.h"
38 #ifdef HAVE_WINDOW_SYSTEM
40 #endif /* HAVE_WINDOW_SYSTEM */
44 # define unicode_append_menu AppendMenuW
45 # else /* !NTGUI_UNICODE */
46 extern AppendMenuW_Proc unicode_append_menu
;
47 # endif /* NTGUI_UNICODE */
48 extern HMENU current_popup_menu
;
49 #endif /* HAVE_NTGUI */
53 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
54 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
58 Lisp_Object menu_items
;
60 /* If non-nil, means that the global vars defined here are already in use.
61 Used to detect cases where we try to re-enter this non-reentrant code. */
62 #if ! (defined USE_GTK || defined USE_MOTIF)
65 Lisp_Object menu_items_inuse
;
67 /* Number of slots currently allocated in menu_items. */
68 int menu_items_allocated
;
70 /* This is the index in menu_items of the first empty slot. */
73 /* The number of panes currently recorded in menu_items,
74 excluding those within submenus. */
75 int menu_items_n_panes
;
77 /* Current depth within submenus. */
78 static int menu_items_submenu_depth
;
81 init_menu_items (void)
83 if (!NILP (menu_items_inuse
))
84 error ("Trying to use a menu from within a menu-entry");
86 if (NILP (menu_items
))
88 menu_items_allocated
= 60;
89 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
92 menu_items_inuse
= Qt
;
94 menu_items_n_panes
= 0;
95 menu_items_submenu_depth
= 0;
98 /* Call at the end of generating the data in menu_items. */
101 finish_menu_items (void)
106 unuse_menu_items (Lisp_Object dummy
)
108 return menu_items_inuse
= Qnil
;
111 /* Call when finished using the data for the current menu
115 discard_menu_items (void)
117 /* Free the structure if it is especially large.
118 Otherwise, hold on to it, to save time. */
119 if (menu_items_allocated
> 200)
122 menu_items_allocated
= 0;
124 eassert (NILP (menu_items_inuse
));
129 cleanup_popup_menu (Lisp_Object arg
)
131 discard_menu_items ();
136 /* This undoes save_menu_items, and it is called by the specpdl unwind
140 restore_menu_items (Lisp_Object saved
)
142 menu_items
= XCAR (saved
);
143 menu_items_inuse
= (! NILP (menu_items
) ? Qt
: Qnil
);
144 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
145 saved
= XCDR (saved
);
146 menu_items_used
= XINT (XCAR (saved
));
147 saved
= XCDR (saved
);
148 menu_items_n_panes
= XINT (XCAR (saved
));
149 saved
= XCDR (saved
);
150 menu_items_submenu_depth
= XINT (XCAR (saved
));
154 /* Push the whole state of menu_items processing onto the specpdl.
155 It will be restored when the specpdl is unwound. */
158 save_menu_items (void)
160 Lisp_Object saved
= list4 (!NILP (menu_items_inuse
) ? menu_items
: Qnil
,
161 make_number (menu_items_used
),
162 make_number (menu_items_n_panes
),
163 make_number (menu_items_submenu_depth
));
164 record_unwind_protect (restore_menu_items
, saved
);
165 menu_items_inuse
= Qnil
;
170 /* Ensure that there is room for ITEMS items in the menu_items vector. */
173 ensure_menu_items (int items
)
175 int incr
= items
- (menu_items_allocated
- menu_items_used
);
178 menu_items
= larger_vector (menu_items
, incr
, INT_MAX
);
179 menu_items_allocated
= ASIZE (menu_items
);
183 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
184 || defined HAVE_NTGUI)
186 /* Begin a submenu. */
189 push_submenu_start (void)
191 ensure_menu_items (1);
192 ASET (menu_items
, menu_items_used
, Qnil
);
194 menu_items_submenu_depth
++;
200 push_submenu_end (void)
202 ensure_menu_items (1);
203 ASET (menu_items
, menu_items_used
, Qlambda
);
205 menu_items_submenu_depth
--;
208 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
210 /* Indicate boundary between left and right. */
213 push_left_right_boundary (void)
215 ensure_menu_items (1);
216 ASET (menu_items
, menu_items_used
, Qquote
);
220 /* Start a new menu pane in menu_items.
221 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
224 push_menu_pane (Lisp_Object name
, Lisp_Object prefix_vec
)
226 ensure_menu_items (MENU_ITEMS_PANE_LENGTH
);
227 if (menu_items_submenu_depth
== 0)
228 menu_items_n_panes
++;
229 ASET (menu_items
, menu_items_used
, Qt
);
231 ASET (menu_items
, menu_items_used
, name
);
233 ASET (menu_items
, menu_items_used
, prefix_vec
);
237 /* Push one menu item into the current pane. NAME is the string to
238 display. ENABLE if non-nil means this item can be selected. KEY
239 is the key generated by choosing this item, or nil if this item
240 doesn't really have a definition. DEF is the definition of this
241 item. EQUIV is the textual description of the keyboard equivalent
242 for this item (or nil if none). TYPE is the type of this menu
243 item, one of nil, `toggle' or `radio'. */
246 push_menu_item (Lisp_Object name
, Lisp_Object enable
, Lisp_Object key
, Lisp_Object def
, Lisp_Object equiv
, Lisp_Object type
, Lisp_Object selected
, Lisp_Object help
)
248 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH
);
250 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_NAME
, name
);
251 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_ENABLE
, enable
);
252 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_VALUE
, key
);
253 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_EQUIV_KEY
, equiv
);
254 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_DEFINITION
, def
);
255 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_TYPE
, type
);
256 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_SELECTED
, selected
);
257 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_HELP
, help
);
259 menu_items_used
+= MENU_ITEMS_ITEM_LENGTH
;
262 /* Args passed between single_keymap_panes and single_menu_item. */
265 Lisp_Object pending_maps
;
270 static void single_menu_item (Lisp_Object
, Lisp_Object
, Lisp_Object
,
273 /* This is a recursive subroutine of keymap_panes.
274 It handles one keymap, KEYMAP.
275 The other arguments are passed along
276 or point to local variables of the previous function.
278 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
281 single_keymap_panes (Lisp_Object keymap
, Lisp_Object pane_name
,
282 Lisp_Object prefix
, int maxdepth
)
287 skp
.pending_maps
= Qnil
;
288 skp
.maxdepth
= maxdepth
;
294 push_menu_pane (pane_name
, prefix
);
297 /* Remember index for first item in this pane so we can go back and
298 add a prefix when (if) we see the first button. After that, notbuttons
299 is set to 0, to mark that we have seen a button and all non button
300 items need a prefix. */
301 skp
.notbuttons
= menu_items_used
;
304 GCPRO1 (skp
.pending_maps
);
305 map_keymap_canonical (keymap
, single_menu_item
, Qnil
, &skp
);
308 /* Process now any submenus which want to be panes at this level. */
309 while (CONSP (skp
.pending_maps
))
311 Lisp_Object elt
, eltcdr
, string
;
312 elt
= XCAR (skp
.pending_maps
);
314 string
= XCAR (eltcdr
);
315 /* We no longer discard the @ from the beginning of the string here.
316 Instead, we do this in *menu_show. */
317 single_keymap_panes (Fcar (elt
), string
, XCDR (eltcdr
), maxdepth
- 1);
318 skp
.pending_maps
= XCDR (skp
.pending_maps
);
322 /* This is a subroutine of single_keymap_panes that handles one
324 KEY is a key in a keymap and ITEM is its binding.
325 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
327 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
330 single_menu_item (Lisp_Object key
, Lisp_Object item
, Lisp_Object dummy
, void *skp_v
)
332 Lisp_Object map
, item_string
, enabled
;
333 struct gcpro gcpro1
, gcpro2
;
335 struct skp
*skp
= skp_v
;
337 /* Parse the menu item and leave the result in item_properties. */
339 res
= parse_menu_item (item
, 0);
342 return; /* Not a menu item. */
344 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
346 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
347 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
349 if (!NILP (map
) && SREF (item_string
, 0) == '@')
352 /* An enabled separate pane. Remember this to handle it later. */
353 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
358 #if defined (HAVE_X_WINDOWS) || defined (MSDOS)
360 /* Simulate radio buttons and toggle boxes by putting a prefix in
363 Lisp_Object prefix
= Qnil
;
364 Lisp_Object type
= AREF (item_properties
, ITEM_PROPERTY_TYPE
);
368 = AREF (item_properties
, ITEM_PROPERTY_SELECTED
);
371 /* The first button. Line up previous items in this menu. */
373 int idx
= skp
->notbuttons
; /* Index for first item this menu. */
376 while (idx
< menu_items_used
)
379 = AREF (menu_items
, idx
+ MENU_ITEMS_ITEM_NAME
);
383 submenu
++; /* Skip sub menu. */
385 else if (EQ (tem
, Qlambda
))
388 submenu
--; /* End sub menu. */
390 else if (EQ (tem
, Qt
))
391 idx
+= 3; /* Skip new pane marker. */
392 else if (EQ (tem
, Qquote
))
393 idx
++; /* Skip a left, right divider. */
396 if (!submenu
&& SREF (tem
, 0) != '\0'
397 && SREF (tem
, 0) != '-')
398 ASET (menu_items
, idx
+ MENU_ITEMS_ITEM_NAME
,
399 concat2 (build_string (" "), tem
));
400 idx
+= MENU_ITEMS_ITEM_LENGTH
;
406 /* Calculate prefix, if any, for this item. */
407 if (EQ (type
, QCtoggle
))
408 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
409 else if (EQ (type
, QCradio
))
410 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
412 /* Not a button. If we have earlier buttons, then we need a prefix. */
413 else if (!skp
->notbuttons
&& SREF (item_string
, 0) != '\0'
414 && SREF (item_string
, 0) != '-')
415 prefix
= build_string (" ");
418 item_string
= concat2 (prefix
, item_string
);
420 #endif /* not HAVE_BOXES */
422 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
424 /* Indicate visually that this is a submenu. */
425 item_string
= concat2 (item_string
, build_string (" >"));
428 #endif /* HAVE_X_WINDOWS || MSDOS */
430 push_menu_item (item_string
, enabled
, key
,
431 AREF (item_properties
, ITEM_PROPERTY_DEF
),
432 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
433 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
434 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
435 AREF (item_properties
, ITEM_PROPERTY_HELP
));
437 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
438 /* Display a submenu using the toolkit. */
439 if (! (NILP (map
) || NILP (enabled
)))
441 push_submenu_start ();
442 single_keymap_panes (map
, Qnil
, key
, skp
->maxdepth
- 1);
448 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
449 and generate menu panes for them in menu_items. */
452 keymap_panes (Lisp_Object
*keymaps
, ptrdiff_t nmaps
)
458 /* Loop over the given keymaps, making a pane for each map.
459 But don't make a pane that is empty--ignore that map instead.
460 P is the number of panes we have made so far. */
461 for (mapno
= 0; mapno
< nmaps
; mapno
++)
462 single_keymap_panes (keymaps
[mapno
],
463 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, 10);
465 finish_menu_items ();
469 /* Push the items in a single pane defined by the alist PANE. */
471 list_of_items (Lisp_Object pane
)
473 Lisp_Object tail
, item
, item1
;
475 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
479 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
480 Qnil
, Qnil
, Qnil
, Qnil
);
481 else if (CONSP (item
))
484 CHECK_STRING (item1
);
485 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
486 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
489 push_left_right_boundary ();
494 /* Push all the panes and items of a menu described by the
495 alist-of-alists MENU.
496 This handles old-fashioned calls to x-popup-menu. */
498 list_of_panes (Lisp_Object menu
)
504 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
506 Lisp_Object elt
, pane_name
, pane_data
;
508 pane_name
= Fcar (elt
);
509 CHECK_STRING (pane_name
);
510 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
511 pane_data
= Fcdr (elt
);
512 CHECK_CONS (pane_data
);
513 list_of_items (pane_data
);
516 finish_menu_items ();
519 /* Set up data in menu_items for a menu bar item
520 whose event type is ITEM_KEY (with string ITEM_NAME)
521 and whose contents come from the list of keymaps MAPS. */
523 parse_single_submenu (Lisp_Object item_key
, Lisp_Object item_name
, Lisp_Object maps
)
529 int top_level_items
= 0;
532 length
= Flength (maps
);
535 /* Convert the list MAPS into a vector MAPVEC. */
536 SAFE_ALLOCA_LISP (mapvec
, len
);
537 for (i
= 0; i
< len
; i
++)
539 mapvec
[i
] = Fcar (maps
);
543 /* Loop over the given keymaps, making a pane for each map.
544 But don't make a pane that is empty--ignore that map instead. */
545 for (i
= 0; i
< len
; i
++)
547 if (!KEYMAPP (mapvec
[i
]))
549 /* Here we have a command at top level in the menu bar
550 as opposed to a submenu. */
552 push_menu_pane (Qnil
, Qnil
);
553 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
554 Qnil
, Qnil
, Qnil
, Qnil
);
559 prompt
= Fkeymap_prompt (mapvec
[i
]);
560 single_keymap_panes (mapvec
[i
],
561 !NILP (prompt
) ? prompt
: item_name
,
567 return top_level_items
;
571 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
573 /* Allocate a widget_value, blocking input. */
576 xmalloc_widget_value (void)
581 value
= malloc_widget_value ();
587 /* This recursively calls free_widget_value on the tree of widgets.
588 It must free all data that was malloc'ed for these widget_values.
589 In Emacs, many slots are pointers into the data of Lisp_Strings, and
590 must be left alone. */
593 free_menubar_widget_value_tree (widget_value
*wv
)
597 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
599 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
601 free_menubar_widget_value_tree (wv
->contents
);
602 wv
->contents
= (widget_value
*) 0xDEADBEEF;
606 free_menubar_widget_value_tree (wv
->next
);
607 wv
->next
= (widget_value
*) 0xDEADBEEF;
610 free_widget_value (wv
);
614 /* Create a tree of widget_value objects
615 representing the panes and items
616 in menu_items starting at index START, up to index END. */
619 digest_single_submenu (int start
, int end
, int top_level_items
)
621 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
623 int submenu_depth
= 0;
624 widget_value
**submenu_stack
;
627 submenu_stack
= alloca (menu_items_used
* sizeof *submenu_stack
);
628 wv
= xmalloc_widget_value ();
632 wv
->button_type
= BUTTON_TYPE_NONE
;
638 /* Loop over all panes and items made by the preceding call
639 to parse_single_submenu and construct a tree of widget_value objects.
640 Ignore the panes and items used by previous calls to
641 digest_single_submenu, even though those are also in menu_items. */
645 if (EQ (AREF (menu_items
, i
), Qnil
))
647 submenu_stack
[submenu_depth
++] = save_wv
;
652 else if (EQ (AREF (menu_items
, i
), Qlambda
))
655 save_wv
= submenu_stack
[--submenu_depth
];
658 else if (EQ (AREF (menu_items
, i
), Qt
)
659 && submenu_depth
!= 0)
660 i
+= MENU_ITEMS_PANE_LENGTH
;
661 /* Ignore a nil in the item list.
662 It's meaningful only for dialog boxes. */
663 else if (EQ (AREF (menu_items
, i
), Qquote
))
665 else if (EQ (AREF (menu_items
, i
), Qt
))
667 /* Create a new pane. */
668 Lisp_Object pane_name
;
669 const char *pane_string
;
673 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
676 if (STRINGP (pane_name
))
678 if (unicode_append_menu
)
679 /* Encode as UTF-8 for now. */
680 pane_name
= ENCODE_UTF_8 (pane_name
);
681 else if (STRING_MULTIBYTE (pane_name
))
682 pane_name
= ENCODE_SYSTEM (pane_name
);
684 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
686 #elif defined (USE_LUCID) && defined (HAVE_XFT)
687 if (STRINGP (pane_name
))
689 pane_name
= ENCODE_UTF_8 (pane_name
);
690 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
692 #elif !defined (HAVE_MULTILINGUAL_MENU)
693 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
695 pane_name
= ENCODE_MENU_STRING (pane_name
);
696 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
700 pane_string
= (NILP (pane_name
)
701 ? "" : SSDATA (pane_name
));
702 /* If there is just one top-level pane, put all its items directly
703 under the top-level menu. */
704 if (menu_items_n_panes
== 1)
707 /* If the pane has a meaningful name,
708 make the pane a top-level menu item
709 with its items as a submenu beneath it. */
710 if (strcmp (pane_string
, ""))
712 wv
= xmalloc_widget_value ();
716 first_wv
->contents
= wv
;
717 wv
->lname
= pane_name
;
718 /* Set value to 1 so update_submenu_strings can handle '@' */
719 wv
->value
= (char *)1;
721 wv
->button_type
= BUTTON_TYPE_NONE
;
729 i
+= MENU_ITEMS_PANE_LENGTH
;
733 /* Create a new item within current pane. */
734 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
737 /* All items should be contained in panes. */
741 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
742 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
743 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
744 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
745 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
746 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
747 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
750 if (STRINGP (item_name
))
752 if (unicode_append_menu
)
753 item_name
= ENCODE_UTF_8 (item_name
);
754 else if (STRING_MULTIBYTE (item_name
))
755 item_name
= ENCODE_SYSTEM (item_name
);
757 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
760 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
762 descrip
= ENCODE_SYSTEM (descrip
);
763 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
766 if (STRINGP (item_name
))
768 item_name
= ENCODE_UTF_8 (item_name
);
769 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
772 if (STRINGP (descrip
))
774 descrip
= ENCODE_UTF_8 (descrip
);
775 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
777 #elif !defined (HAVE_MULTILINGUAL_MENU)
778 if (STRING_MULTIBYTE (item_name
))
780 item_name
= ENCODE_MENU_STRING (item_name
);
781 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
784 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
786 descrip
= ENCODE_MENU_STRING (descrip
);
787 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
791 wv
= xmalloc_widget_value ();
795 save_wv
->contents
= wv
;
797 wv
->lname
= item_name
;
801 /* The intptr_t cast avoids a warning. There's no problem
802 as long as pointers have enough bits to hold small integers. */
803 wv
->call_data
= (!NILP (def
) ? (void *) (intptr_t) i
: 0);
804 wv
->enabled
= !NILP (enable
);
807 wv
->button_type
= BUTTON_TYPE_NONE
;
808 else if (EQ (type
, QCradio
))
809 wv
->button_type
= BUTTON_TYPE_RADIO
;
810 else if (EQ (type
, QCtoggle
))
811 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
815 wv
->selected
= !NILP (selected
);
816 if (! STRINGP (help
))
823 i
+= MENU_ITEMS_ITEM_LENGTH
;
827 /* If we have just one "menu item"
828 that was originally a button, return it by itself. */
829 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
831 wv
= first_wv
->contents
;
832 free_widget_value (first_wv
);
839 /* Walk through the widget_value tree starting at FIRST_WV and update
840 the char * pointers from the corresponding lisp values.
841 We do this after building the whole tree, since GC may happen while the
842 tree is constructed, and small strings are relocated. So we must wait
843 until no GC can happen before storing pointers into lisp values. */
845 update_submenu_strings (widget_value
*first_wv
)
849 for (wv
= first_wv
; wv
; wv
= wv
->next
)
851 if (STRINGP (wv
->lname
))
853 wv
->name
= SSDATA (wv
->lname
);
855 /* Ignore the @ that means "separate pane".
856 This is a kludge, but this isn't worth more time. */
857 if (wv
->value
== (char *)1)
859 if (wv
->name
[0] == '@')
865 if (STRINGP (wv
->lkey
))
866 wv
->key
= SSDATA (wv
->lkey
);
869 update_submenu_strings (wv
->contents
);
873 /* Find the menu selection and store it in the keyboard buffer.
874 F is the frame the menu is on.
875 MENU_BAR_ITEMS_USED is the length of VECTOR.
876 VECTOR is an array of menu events for the whole menu. */
879 find_and_call_menu_selection (FRAME_PTR f
, int menu_bar_items_used
, Lisp_Object vector
, void *client_data
)
881 Lisp_Object prefix
, entry
;
882 Lisp_Object
*subprefix_stack
;
883 int submenu_depth
= 0;
887 subprefix_stack
= alloca (menu_bar_items_used
* sizeof *subprefix_stack
);
891 while (i
< menu_bar_items_used
)
893 if (EQ (AREF (vector
, i
), Qnil
))
895 subprefix_stack
[submenu_depth
++] = prefix
;
899 else if (EQ (AREF (vector
, i
), Qlambda
))
901 prefix
= subprefix_stack
[--submenu_depth
];
904 else if (EQ (AREF (vector
, i
), Qt
))
906 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
907 i
+= MENU_ITEMS_PANE_LENGTH
;
911 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
912 /* Treat the pointer as an integer. There's no problem
913 as long as pointers have enough bits to hold small integers. */
914 if ((intptr_t) client_data
== i
)
917 struct input_event buf
;
921 XSETFRAME (frame
, f
);
922 buf
.kind
= MENU_BAR_EVENT
;
923 buf
.frame_or_window
= frame
;
925 kbd_buffer_store_event (&buf
);
927 for (j
= 0; j
< submenu_depth
; j
++)
928 if (!NILP (subprefix_stack
[j
]))
930 buf
.kind
= MENU_BAR_EVENT
;
931 buf
.frame_or_window
= frame
;
932 buf
.arg
= subprefix_stack
[j
];
933 kbd_buffer_store_event (&buf
);
938 buf
.kind
= MENU_BAR_EVENT
;
939 buf
.frame_or_window
= frame
;
941 kbd_buffer_store_event (&buf
);
944 buf
.kind
= MENU_BAR_EVENT
;
945 buf
.frame_or_window
= frame
;
947 kbd_buffer_store_event (&buf
);
951 i
+= MENU_ITEMS_ITEM_LENGTH
;
956 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
959 /* As above, but return the menu selection instead of storing in kb buffer.
960 If keymaps==1, return full prefixes to selection. */
962 find_and_return_menu_selection (FRAME_PTR f
, int keymaps
, void *client_data
)
964 Lisp_Object prefix
, entry
;
966 Lisp_Object
*subprefix_stack
;
967 int submenu_depth
= 0;
969 prefix
= entry
= Qnil
;
971 subprefix_stack
= alloca (menu_items_used
* word_size
);
973 while (i
< menu_items_used
)
975 if (EQ (AREF (menu_items
, i
), Qnil
))
977 subprefix_stack
[submenu_depth
++] = prefix
;
981 else if (EQ (AREF (menu_items
, i
), Qlambda
))
983 prefix
= subprefix_stack
[--submenu_depth
];
986 else if (EQ (AREF (menu_items
, i
), Qt
))
989 = AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
990 i
+= MENU_ITEMS_PANE_LENGTH
;
992 /* Ignore a nil in the item list.
993 It's meaningful only for dialog boxes. */
994 else if (EQ (AREF (menu_items
, i
), Qquote
))
999 = AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1000 if (aref_addr (menu_items
, i
) == client_data
)
1006 entry
= Fcons (entry
, Qnil
);
1008 entry
= Fcons (prefix
, entry
);
1009 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1010 if (!NILP (subprefix_stack
[j
]))
1011 entry
= Fcons (subprefix_stack
[j
], entry
);
1015 i
+= MENU_ITEMS_ITEM_LENGTH
;
1020 #endif /* HAVE_NS */
1022 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
1023 doc
: /* Pop up a deck-of-cards menu and return user's selection.
1024 POSITION is a position specification. This is either a mouse button event
1025 or a list ((XOFFSET YOFFSET) WINDOW)
1026 where XOFFSET and YOFFSET are positions in pixels from the top left
1027 corner of WINDOW. (WINDOW may be a window or a frame object.)
1028 This controls the position of the top left of the menu as a whole.
1029 If POSITION is t, it means to use the current mouse position.
1031 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1032 The menu items come from key bindings that have a menu string as well as
1033 a definition; actually, the "definition" in such a key binding looks like
1034 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1035 the keymap as a top-level element.
1037 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1038 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1040 You can also use a list of keymaps as MENU.
1041 Then each keymap makes a separate pane.
1043 When MENU is a keymap or a list of keymaps, the return value is the
1044 list of events corresponding to the user's choice. Note that
1045 `x-popup-menu' does not actually execute the command bound to that
1048 Alternatively, you can specify a menu of multiple panes
1049 with a list of the form (TITLE PANE1 PANE2...),
1050 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1051 Each ITEM is normally a cons cell (STRING . VALUE);
1052 but a string can appear as an item--that makes a nonselectable line
1054 With this form of menu, the return value is VALUE from the chosen item.
1056 If POSITION is nil, don't display the menu at all, just precalculate the
1057 cached information about equivalent key sequences.
1059 If the user gets rid of the menu without making a valid choice, for
1060 instance by clicking the mouse away from a valid choice or by typing
1061 keyboard input, then this normally results in a quit and
1062 `x-popup-menu' does not return. But if POSITION is a mouse button
1063 event (indicating that the user invoked the menu with the mouse) then
1064 no quit occurs and `x-popup-menu' returns nil. */)
1065 (Lisp_Object position
, Lisp_Object menu
)
1067 Lisp_Object keymap
, tem
;
1068 int xpos
= 0, ypos
= 0;
1070 const char *error_name
= NULL
;
1071 Lisp_Object selection
= Qnil
;
1073 Lisp_Object x
, y
, window
;
1076 ptrdiff_t specpdl_count
= SPECPDL_INDEX ();
1077 struct gcpro gcpro1
;
1079 if (NILP (position
))
1080 /* This is an obsolete call, which wants us to precompute the
1081 keybinding equivalents, but we don't do that any more anyway. */
1086 int get_current_pos_p
= 0;
1087 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1089 /* Decode the first argument: find the window and the coordinates. */
1090 if (EQ (position
, Qt
)
1091 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
1092 || EQ (XCAR (position
), Qtool_bar
))))
1094 get_current_pos_p
= 1;
1098 tem
= Fcar (position
);
1101 window
= Fcar (Fcdr (position
));
1103 y
= Fcar (XCDR (tem
));
1108 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1109 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1110 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
1115 /* If a click happens in an external tool bar or a detached
1116 tool bar, x and y is NIL. In that case, use the current
1117 mouse position. This happens for the help button in the
1118 tool bar. Ideally popup-menu should pass NIL to
1119 this function, but it doesn't. */
1120 if (NILP (x
) && NILP (y
))
1121 get_current_pos_p
= 1;
1124 if (get_current_pos_p
)
1126 /* Use the mouse's current position. */
1127 FRAME_PTR new_f
= SELECTED_FRAME ();
1128 #ifdef HAVE_X_WINDOWS
1129 /* Can't use mouse_position_hook for X since it returns
1130 coordinates relative to the window the mouse is in,
1131 we need coordinates relative to the edit widget always. */
1136 mouse_position_for_popup (new_f
, &cur_x
, &cur_y
);
1137 /* cur_x/y may be negative, so use make_number. */
1138 x
= make_number (cur_x
);
1139 y
= make_number (cur_y
);
1142 #else /* not HAVE_X_WINDOWS */
1143 Lisp_Object bar_window
;
1144 enum scroll_bar_part part
;
1146 void (*mouse_position_hook
) (struct frame
**, int,
1148 enum scroll_bar_part
*,
1152 FRAME_TERMINAL (new_f
)->mouse_position_hook
;
1154 if (mouse_position_hook
)
1155 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
1156 &part
, &x
, &y
, &time
);
1157 #endif /* not HAVE_X_WINDOWS */
1160 XSETFRAME (window
, new_f
);
1163 window
= selected_window
;
1169 /* Decode where to put the menu. */
1171 if (FRAMEP (window
))
1173 f
= XFRAME (window
);
1177 else if (WINDOWP (window
))
1179 struct window
*win
= XWINDOW (window
);
1180 CHECK_LIVE_WINDOW (window
);
1181 f
= XFRAME (WINDOW_FRAME (win
));
1183 xpos
= WINDOW_LEFT_EDGE_X (win
);
1184 ypos
= WINDOW_TOP_EDGE_Y (win
);
1187 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1188 but I don't want to make one now. */
1189 CHECK_WINDOW (window
);
1191 CHECK_RANGED_INTEGER (x
,
1192 (xpos
< INT_MIN
- MOST_NEGATIVE_FIXNUM
1193 ? (EMACS_INT
) INT_MIN
- xpos
1194 : MOST_NEGATIVE_FIXNUM
),
1196 CHECK_RANGED_INTEGER (y
,
1197 (ypos
< INT_MIN
- MOST_NEGATIVE_FIXNUM
1198 ? (EMACS_INT
) INT_MIN
- ypos
1199 : MOST_NEGATIVE_FIXNUM
),
1204 /* FIXME: Find a more general check! */
1205 if (!(FRAME_X_P (f
) || FRAME_MSDOS_P (f
)
1206 || FRAME_W32_P (f
) || FRAME_NS_P (f
)))
1207 error ("Can not put GUI menu on this terminal");
1209 XSETFRAME (Vmenu_updating_frame
, f
);
1211 #endif /* HAVE_MENUS */
1213 /* Now parse the lisp menus. */
1214 record_unwind_protect (unuse_menu_items
, Qnil
);
1219 /* Decode the menu items from what was specified. */
1221 keymap
= get_keymap (menu
, 0, 0);
1224 /* We were given a keymap. Extract menu info from the keymap. */
1227 /* Extract the detailed info to make one pane. */
1228 keymap_panes (&menu
, 1);
1230 /* Search for a string appearing directly as an element of the keymap.
1231 That string is the title of the menu. */
1232 prompt
= Fkeymap_prompt (keymap
);
1235 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1237 title
= build_string ("Select");
1240 /* Make that be the pane title of the first pane. */
1241 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
1242 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
1246 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
1248 /* We were given a list of keymaps. */
1249 EMACS_INT nmaps
= XFASTINT (Flength (menu
));
1254 SAFE_ALLOCA_LISP (maps
, nmaps
);
1257 /* The first keymap that has a prompt string
1258 supplies the menu title. */
1259 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
1263 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
1265 prompt
= Fkeymap_prompt (keymap
);
1266 if (NILP (title
) && !NILP (prompt
))
1270 /* Extract the detailed info to make one pane. */
1271 keymap_panes (maps
, nmaps
);
1273 /* Make the title be the pane title of the first pane. */
1274 if (!NILP (title
) && menu_items_n_panes
>= 0)
1275 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
1283 /* We were given an old-fashioned menu. */
1284 title
= Fcar (menu
);
1285 CHECK_STRING (title
);
1287 list_of_panes (Fcdr (menu
));
1292 unbind_to (specpdl_count
, Qnil
);
1295 #ifdef HAVE_WINDOW_SYSTEM
1296 /* Hide a previous tip, if any. */
1300 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1301 /* If resources from a previous popup menu still exist, does nothing
1302 until the `menu_free_timer' has freed them (see w32fns.c). This
1303 can occur if you press ESC or click outside a menu without selecting
1306 if (current_popup_menu
)
1308 discard_menu_items ();
1309 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1315 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1316 record_unwind_protect (cleanup_popup_menu
, Qnil
);
1319 /* Display them in a menu. */
1322 /* FIXME: Use a terminal hook! */
1323 #if defined HAVE_NTGUI
1324 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
1325 keymaps
, title
, &error_name
);
1326 #elif defined HAVE_NS
1327 selection
= ns_menu_show (f
, xpos
, ypos
, for_click
,
1328 keymaps
, title
, &error_name
);
1329 #else /* MSDOS and X11 */
1330 /* Assume last_event_timestamp is the timestamp of the button event.
1331 Is this assumption ever violated? We can't use the timestamp
1332 stored within POSITION because there the top bits from the actual
1333 timestamp may be truncated away (Bug#4930). */
1334 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
1335 keymaps
, title
, &error_name
,
1336 last_event_timestamp
);
1342 unbind_to (specpdl_count
, Qnil
);
1344 discard_menu_items ();
1347 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1348 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1351 #endif /* HAVE_MENUS */
1355 if (error_name
) error ("%s", error_name
);
1362 staticpro (&menu_items
);
1364 menu_items_inuse
= Qnil
;
1366 defsubr (&Sx_popup_menu
);