1 /* Platform-independent code for terminal communications.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2013 Free Software
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 (void)
108 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
));
127 /* This undoes save_menu_items, and it is called by the specpdl unwind
131 restore_menu_items (Lisp_Object saved
)
133 menu_items
= XCAR (saved
);
134 menu_items_inuse
= (! NILP (menu_items
) ? Qt
: Qnil
);
135 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
136 saved
= XCDR (saved
);
137 menu_items_used
= XINT (XCAR (saved
));
138 saved
= XCDR (saved
);
139 menu_items_n_panes
= XINT (XCAR (saved
));
140 saved
= XCDR (saved
);
141 menu_items_submenu_depth
= XINT (XCAR (saved
));
144 /* Push the whole state of menu_items processing onto the specpdl.
145 It will be restored when the specpdl is unwound. */
148 save_menu_items (void)
150 Lisp_Object saved
= list4 (!NILP (menu_items_inuse
) ? menu_items
: Qnil
,
151 make_number (menu_items_used
),
152 make_number (menu_items_n_panes
),
153 make_number (menu_items_submenu_depth
));
154 record_unwind_protect (restore_menu_items
, saved
);
155 menu_items_inuse
= Qnil
;
160 /* Ensure that there is room for ITEMS items in the menu_items vector. */
163 ensure_menu_items (int items
)
165 int incr
= items
- (menu_items_allocated
- menu_items_used
);
168 menu_items
= larger_vector (menu_items
, incr
, INT_MAX
);
169 menu_items_allocated
= ASIZE (menu_items
);
173 #if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \
174 || defined HAVE_NTGUI)
176 /* Begin a submenu. */
179 push_submenu_start (void)
181 ensure_menu_items (1);
182 ASET (menu_items
, menu_items_used
, Qnil
);
184 menu_items_submenu_depth
++;
190 push_submenu_end (void)
192 ensure_menu_items (1);
193 ASET (menu_items
, menu_items_used
, Qlambda
);
195 menu_items_submenu_depth
--;
198 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */
200 /* Indicate boundary between left and right. */
203 push_left_right_boundary (void)
205 ensure_menu_items (1);
206 ASET (menu_items
, menu_items_used
, Qquote
);
210 /* Start a new menu pane in menu_items.
211 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
214 push_menu_pane (Lisp_Object name
, Lisp_Object prefix_vec
)
216 ensure_menu_items (MENU_ITEMS_PANE_LENGTH
);
217 if (menu_items_submenu_depth
== 0)
218 menu_items_n_panes
++;
219 ASET (menu_items
, menu_items_used
, Qt
);
221 ASET (menu_items
, menu_items_used
, name
);
223 ASET (menu_items
, menu_items_used
, prefix_vec
);
227 /* Push one menu item into the current pane. NAME is the string to
228 display. ENABLE if non-nil means this item can be selected. KEY
229 is the key generated by choosing this item, or nil if this item
230 doesn't really have a definition. DEF is the definition of this
231 item. EQUIV is the textual description of the keyboard equivalent
232 for this item (or nil if none). TYPE is the type of this menu
233 item, one of nil, `toggle' or `radio'. */
236 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
)
238 ensure_menu_items (MENU_ITEMS_ITEM_LENGTH
);
240 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_NAME
, name
);
241 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_ENABLE
, enable
);
242 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_VALUE
, key
);
243 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_EQUIV_KEY
, equiv
);
244 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_DEFINITION
, def
);
245 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_TYPE
, type
);
246 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_SELECTED
, selected
);
247 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_HELP
, help
);
249 menu_items_used
+= MENU_ITEMS_ITEM_LENGTH
;
252 /* Args passed between single_keymap_panes and single_menu_item. */
255 Lisp_Object pending_maps
;
260 static void single_menu_item (Lisp_Object
, Lisp_Object
, Lisp_Object
,
263 /* This is a recursive subroutine of keymap_panes.
264 It handles one keymap, KEYMAP.
265 The other arguments are passed along
266 or point to local variables of the previous function.
268 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
271 single_keymap_panes (Lisp_Object keymap
, Lisp_Object pane_name
,
272 Lisp_Object prefix
, int maxdepth
)
277 skp
.pending_maps
= Qnil
;
278 skp
.maxdepth
= maxdepth
;
284 push_menu_pane (pane_name
, prefix
);
287 /* Remember index for first item in this pane so we can go back and
288 add a prefix when (if) we see the first button. After that, notbuttons
289 is set to 0, to mark that we have seen a button and all non button
290 items need a prefix. */
291 skp
.notbuttons
= menu_items_used
;
294 GCPRO1 (skp
.pending_maps
);
295 map_keymap_canonical (keymap
, single_menu_item
, Qnil
, &skp
);
298 /* Process now any submenus which want to be panes at this level. */
299 while (CONSP (skp
.pending_maps
))
301 Lisp_Object elt
, eltcdr
, string
;
302 elt
= XCAR (skp
.pending_maps
);
304 string
= XCAR (eltcdr
);
305 /* We no longer discard the @ from the beginning of the string here.
306 Instead, we do this in *menu_show. */
307 single_keymap_panes (Fcar (elt
), string
, XCDR (eltcdr
), maxdepth
- 1);
308 skp
.pending_maps
= XCDR (skp
.pending_maps
);
312 /* This is a subroutine of single_keymap_panes that handles one
314 KEY is a key in a keymap and ITEM is its binding.
315 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
317 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
320 single_menu_item (Lisp_Object key
, Lisp_Object item
, Lisp_Object dummy
, void *skp_v
)
322 Lisp_Object map
, item_string
, enabled
;
323 struct gcpro gcpro1
, gcpro2
;
325 struct skp
*skp
= skp_v
;
327 /* Parse the menu item and leave the result in item_properties. */
329 res
= parse_menu_item (item
, 0);
332 return; /* Not a menu item. */
334 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
336 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
337 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
339 if (!NILP (map
) && SREF (item_string
, 0) == '@')
342 /* An enabled separate pane. Remember this to handle it later. */
343 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
348 #if defined (HAVE_X_WINDOWS) || defined (MSDOS)
350 /* Simulate radio buttons and toggle boxes by putting a prefix in
353 Lisp_Object prefix
= Qnil
;
354 Lisp_Object type
= AREF (item_properties
, ITEM_PROPERTY_TYPE
);
358 = AREF (item_properties
, ITEM_PROPERTY_SELECTED
);
361 /* The first button. Line up previous items in this menu. */
363 int idx
= skp
->notbuttons
; /* Index for first item this menu. */
366 while (idx
< menu_items_used
)
369 = AREF (menu_items
, idx
+ MENU_ITEMS_ITEM_NAME
);
373 submenu
++; /* Skip sub menu. */
375 else if (EQ (tem
, Qlambda
))
378 submenu
--; /* End sub menu. */
380 else if (EQ (tem
, Qt
))
381 idx
+= 3; /* Skip new pane marker. */
382 else if (EQ (tem
, Qquote
))
383 idx
++; /* Skip a left, right divider. */
386 if (!submenu
&& SREF (tem
, 0) != '\0'
387 && SREF (tem
, 0) != '-')
388 ASET (menu_items
, idx
+ MENU_ITEMS_ITEM_NAME
,
389 concat2 (build_string (" "), tem
));
390 idx
+= MENU_ITEMS_ITEM_LENGTH
;
396 /* Calculate prefix, if any, for this item. */
397 if (EQ (type
, QCtoggle
))
398 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
399 else if (EQ (type
, QCradio
))
400 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
402 /* Not a button. If we have earlier buttons, then we need a prefix. */
403 else if (!skp
->notbuttons
&& SREF (item_string
, 0) != '\0'
404 && SREF (item_string
, 0) != '-')
405 prefix
= build_string (" ");
408 item_string
= concat2 (prefix
, item_string
);
410 #endif /* not HAVE_BOXES */
412 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
414 /* Indicate visually that this is a submenu. */
415 item_string
= concat2 (item_string
, build_string (" >"));
418 #endif /* HAVE_X_WINDOWS || MSDOS */
420 push_menu_item (item_string
, enabled
, key
,
421 AREF (item_properties
, ITEM_PROPERTY_DEF
),
422 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
423 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
424 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
425 AREF (item_properties
, ITEM_PROPERTY_HELP
));
427 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
428 /* Display a submenu using the toolkit. */
429 if (! (NILP (map
) || NILP (enabled
)))
431 push_submenu_start ();
432 single_keymap_panes (map
, Qnil
, key
, skp
->maxdepth
- 1);
438 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
439 and generate menu panes for them in menu_items. */
442 keymap_panes (Lisp_Object
*keymaps
, ptrdiff_t nmaps
)
448 /* Loop over the given keymaps, making a pane for each map.
449 But don't make a pane that is empty--ignore that map instead.
450 P is the number of panes we have made so far. */
451 for (mapno
= 0; mapno
< nmaps
; mapno
++)
452 single_keymap_panes (keymaps
[mapno
],
453 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, 10);
455 finish_menu_items ();
459 /* Push the items in a single pane defined by the alist PANE. */
461 list_of_items (Lisp_Object pane
)
463 Lisp_Object tail
, item
, item1
;
465 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
469 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
470 Qnil
, Qnil
, Qnil
, Qnil
);
471 else if (CONSP (item
))
474 CHECK_STRING (item1
);
475 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
476 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
479 push_left_right_boundary ();
484 /* Push all the panes and items of a menu described by the
485 alist-of-alists MENU.
486 This handles old-fashioned calls to x-popup-menu. */
488 list_of_panes (Lisp_Object menu
)
494 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
496 Lisp_Object elt
, pane_name
, pane_data
;
498 pane_name
= Fcar (elt
);
499 CHECK_STRING (pane_name
);
500 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
501 pane_data
= Fcdr (elt
);
502 CHECK_CONS (pane_data
);
503 list_of_items (pane_data
);
506 finish_menu_items ();
509 /* Set up data in menu_items for a menu bar item
510 whose event type is ITEM_KEY (with string ITEM_NAME)
511 and whose contents come from the list of keymaps MAPS. */
513 parse_single_submenu (Lisp_Object item_key
, Lisp_Object item_name
,
520 bool top_level_items
= 0;
523 length
= Flength (maps
);
526 /* Convert the list MAPS into a vector MAPVEC. */
527 SAFE_ALLOCA_LISP (mapvec
, len
);
528 for (i
= 0; i
< len
; i
++)
530 mapvec
[i
] = Fcar (maps
);
534 /* Loop over the given keymaps, making a pane for each map.
535 But don't make a pane that is empty--ignore that map instead. */
536 for (i
= 0; i
< len
; i
++)
538 if (!KEYMAPP (mapvec
[i
]))
540 /* Here we have a command at top level in the menu bar
541 as opposed to a submenu. */
543 push_menu_pane (Qnil
, Qnil
);
544 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
545 Qnil
, Qnil
, Qnil
, Qnil
);
550 prompt
= Fkeymap_prompt (mapvec
[i
]);
551 single_keymap_panes (mapvec
[i
],
552 !NILP (prompt
) ? prompt
: item_name
,
558 return top_level_items
;
562 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
564 /* Allocate a widget_value, blocking input. */
567 xmalloc_widget_value (void)
572 value
= malloc_widget_value ();
578 /* This recursively calls free_widget_value on the tree of widgets.
579 It must free all data that was malloc'ed for these widget_values.
580 In Emacs, many slots are pointers into the data of Lisp_Strings, and
581 must be left alone. */
584 free_menubar_widget_value_tree (widget_value
*wv
)
588 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
590 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
592 free_menubar_widget_value_tree (wv
->contents
);
593 wv
->contents
= (widget_value
*) 0xDEADBEEF;
597 free_menubar_widget_value_tree (wv
->next
);
598 wv
->next
= (widget_value
*) 0xDEADBEEF;
601 free_widget_value (wv
);
605 /* Create a tree of widget_value objects
606 representing the panes and items
607 in menu_items starting at index START, up to index END. */
610 digest_single_submenu (int start
, int end
, bool top_level_items
)
612 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
614 int submenu_depth
= 0;
615 widget_value
**submenu_stack
;
618 submenu_stack
= alloca (menu_items_used
* sizeof *submenu_stack
);
619 wv
= xmalloc_widget_value ();
623 wv
->button_type
= BUTTON_TYPE_NONE
;
629 /* Loop over all panes and items made by the preceding call
630 to parse_single_submenu and construct a tree of widget_value objects.
631 Ignore the panes and items used by previous calls to
632 digest_single_submenu, even though those are also in menu_items. */
636 if (EQ (AREF (menu_items
, i
), Qnil
))
638 submenu_stack
[submenu_depth
++] = save_wv
;
643 else if (EQ (AREF (menu_items
, i
), Qlambda
))
646 save_wv
= submenu_stack
[--submenu_depth
];
649 else if (EQ (AREF (menu_items
, i
), Qt
)
650 && submenu_depth
!= 0)
651 i
+= MENU_ITEMS_PANE_LENGTH
;
652 /* Ignore a nil in the item list.
653 It's meaningful only for dialog boxes. */
654 else if (EQ (AREF (menu_items
, i
), Qquote
))
656 else if (EQ (AREF (menu_items
, i
), Qt
))
658 /* Create a new pane. */
659 Lisp_Object pane_name
;
660 const char *pane_string
;
664 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
667 if (STRINGP (pane_name
))
669 if (unicode_append_menu
)
670 /* Encode as UTF-8 for now. */
671 pane_name
= ENCODE_UTF_8 (pane_name
);
672 else if (STRING_MULTIBYTE (pane_name
))
673 pane_name
= ENCODE_SYSTEM (pane_name
);
675 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
677 #elif defined (USE_LUCID) && defined (HAVE_XFT)
678 if (STRINGP (pane_name
))
680 pane_name
= ENCODE_UTF_8 (pane_name
);
681 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
683 #elif !defined (HAVE_MULTILINGUAL_MENU)
684 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
686 pane_name
= ENCODE_MENU_STRING (pane_name
);
687 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
691 pane_string
= (NILP (pane_name
)
692 ? "" : SSDATA (pane_name
));
693 /* If there is just one top-level pane, put all its items directly
694 under the top-level menu. */
695 if (menu_items_n_panes
== 1)
698 /* If the pane has a meaningful name,
699 make the pane a top-level menu item
700 with its items as a submenu beneath it. */
701 if (strcmp (pane_string
, ""))
703 wv
= xmalloc_widget_value ();
707 first_wv
->contents
= wv
;
708 wv
->lname
= pane_name
;
709 /* Set value to 1 so update_submenu_strings can handle '@' */
710 wv
->value
= (char *)1;
712 wv
->button_type
= BUTTON_TYPE_NONE
;
720 i
+= MENU_ITEMS_PANE_LENGTH
;
724 /* Create a new item within current pane. */
725 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
728 /* All items should be contained in panes. */
732 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
733 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
734 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
735 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
736 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
737 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
738 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
741 if (STRINGP (item_name
))
743 if (unicode_append_menu
)
744 item_name
= ENCODE_UTF_8 (item_name
);
745 else if (STRING_MULTIBYTE (item_name
))
746 item_name
= ENCODE_SYSTEM (item_name
);
748 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
751 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
753 descrip
= ENCODE_SYSTEM (descrip
);
754 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
757 if (STRINGP (item_name
))
759 item_name
= ENCODE_UTF_8 (item_name
);
760 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
763 if (STRINGP (descrip
))
765 descrip
= ENCODE_UTF_8 (descrip
);
766 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
768 #elif !defined (HAVE_MULTILINGUAL_MENU)
769 if (STRING_MULTIBYTE (item_name
))
771 item_name
= ENCODE_MENU_STRING (item_name
);
772 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
775 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
777 descrip
= ENCODE_MENU_STRING (descrip
);
778 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
782 wv
= xmalloc_widget_value ();
786 save_wv
->contents
= wv
;
788 wv
->lname
= item_name
;
792 /* The intptr_t cast avoids a warning. There's no problem
793 as long as pointers have enough bits to hold small integers. */
794 wv
->call_data
= (!NILP (def
) ? (void *) (intptr_t) i
: 0);
795 wv
->enabled
= !NILP (enable
);
798 wv
->button_type
= BUTTON_TYPE_NONE
;
799 else if (EQ (type
, QCradio
))
800 wv
->button_type
= BUTTON_TYPE_RADIO
;
801 else if (EQ (type
, QCtoggle
))
802 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
806 wv
->selected
= !NILP (selected
);
807 if (! STRINGP (help
))
814 i
+= MENU_ITEMS_ITEM_LENGTH
;
818 /* If we have just one "menu item"
819 that was originally a button, return it by itself. */
820 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
822 wv
= first_wv
->contents
;
823 free_widget_value (first_wv
);
830 /* Walk through the widget_value tree starting at FIRST_WV and update
831 the char * pointers from the corresponding lisp values.
832 We do this after building the whole tree, since GC may happen while the
833 tree is constructed, and small strings are relocated. So we must wait
834 until no GC can happen before storing pointers into lisp values. */
836 update_submenu_strings (widget_value
*first_wv
)
840 for (wv
= first_wv
; wv
; wv
= wv
->next
)
842 if (STRINGP (wv
->lname
))
844 wv
->name
= SSDATA (wv
->lname
);
846 /* Ignore the @ that means "separate pane".
847 This is a kludge, but this isn't worth more time. */
848 if (wv
->value
== (char *)1)
850 if (wv
->name
[0] == '@')
856 if (STRINGP (wv
->lkey
))
857 wv
->key
= SSDATA (wv
->lkey
);
860 update_submenu_strings (wv
->contents
);
864 /* Find the menu selection and store it in the keyboard buffer.
865 F is the frame the menu is on.
866 MENU_BAR_ITEMS_USED is the length of VECTOR.
867 VECTOR is an array of menu events for the whole menu. */
870 find_and_call_menu_selection (FRAME_PTR f
, int menu_bar_items_used
, Lisp_Object vector
, void *client_data
)
872 Lisp_Object prefix
, entry
;
873 Lisp_Object
*subprefix_stack
;
874 int submenu_depth
= 0;
878 subprefix_stack
= alloca (menu_bar_items_used
* sizeof *subprefix_stack
);
882 while (i
< menu_bar_items_used
)
884 if (EQ (AREF (vector
, i
), Qnil
))
886 subprefix_stack
[submenu_depth
++] = prefix
;
890 else if (EQ (AREF (vector
, i
), Qlambda
))
892 prefix
= subprefix_stack
[--submenu_depth
];
895 else if (EQ (AREF (vector
, i
), Qt
))
897 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
898 i
+= MENU_ITEMS_PANE_LENGTH
;
902 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
903 /* Treat the pointer as an integer. There's no problem
904 as long as pointers have enough bits to hold small integers. */
905 if ((intptr_t) client_data
== i
)
908 struct input_event buf
;
912 XSETFRAME (frame
, f
);
913 buf
.kind
= MENU_BAR_EVENT
;
914 buf
.frame_or_window
= frame
;
916 kbd_buffer_store_event (&buf
);
918 for (j
= 0; j
< submenu_depth
; j
++)
919 if (!NILP (subprefix_stack
[j
]))
921 buf
.kind
= MENU_BAR_EVENT
;
922 buf
.frame_or_window
= frame
;
923 buf
.arg
= subprefix_stack
[j
];
924 kbd_buffer_store_event (&buf
);
929 buf
.kind
= MENU_BAR_EVENT
;
930 buf
.frame_or_window
= frame
;
932 kbd_buffer_store_event (&buf
);
935 buf
.kind
= MENU_BAR_EVENT
;
936 buf
.frame_or_window
= frame
;
938 kbd_buffer_store_event (&buf
);
942 i
+= MENU_ITEMS_ITEM_LENGTH
;
947 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
950 /* As above, but return the menu selection instead of storing in kb buffer.
951 If KEYMAPS, return full prefixes to selection. */
953 find_and_return_menu_selection (FRAME_PTR f
, bool keymaps
, void *client_data
)
955 Lisp_Object prefix
, entry
;
957 Lisp_Object
*subprefix_stack
;
958 int submenu_depth
= 0;
960 prefix
= entry
= Qnil
;
962 subprefix_stack
= alloca (menu_items_used
* word_size
);
964 while (i
< menu_items_used
)
966 if (EQ (AREF (menu_items
, i
), Qnil
))
968 subprefix_stack
[submenu_depth
++] = prefix
;
972 else if (EQ (AREF (menu_items
, i
), Qlambda
))
974 prefix
= subprefix_stack
[--submenu_depth
];
977 else if (EQ (AREF (menu_items
, i
), Qt
))
980 = AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
981 i
+= MENU_ITEMS_PANE_LENGTH
;
983 /* Ignore a nil in the item list.
984 It's meaningful only for dialog boxes. */
985 else if (EQ (AREF (menu_items
, i
), Qquote
))
990 = AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
991 if (aref_addr (menu_items
, i
) == client_data
)
997 entry
= list1 (entry
);
999 entry
= Fcons (prefix
, entry
);
1000 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1001 if (!NILP (subprefix_stack
[j
]))
1002 entry
= Fcons (subprefix_stack
[j
], entry
);
1006 i
+= MENU_ITEMS_ITEM_LENGTH
;
1011 #endif /* HAVE_NS */
1013 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
1014 doc
: /* Pop up a deck-of-cards menu and return user's selection.
1015 POSITION is a position specification. This is either a mouse button event
1016 or a list ((XOFFSET YOFFSET) WINDOW)
1017 where XOFFSET and YOFFSET are positions in pixels from the top left
1018 corner of WINDOW. (WINDOW may be a window or a frame object.)
1019 This controls the position of the top left of the menu as a whole.
1020 If POSITION is t, it means to use the current mouse position.
1022 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1023 The menu items come from key bindings that have a menu string as well as
1024 a definition; actually, the "definition" in such a key binding looks like
1025 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1026 the keymap as a top-level element.
1028 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1029 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1031 You can also use a list of keymaps as MENU.
1032 Then each keymap makes a separate pane.
1034 When MENU is a keymap or a list of keymaps, the return value is the
1035 list of events corresponding to the user's choice. Note that
1036 `x-popup-menu' does not actually execute the command bound to that
1039 Alternatively, you can specify a menu of multiple panes
1040 with a list of the form (TITLE PANE1 PANE2...),
1041 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1042 Each ITEM is normally a cons cell (STRING . VALUE);
1043 but a string can appear as an item--that makes a nonselectable line
1045 With this form of menu, the return value is VALUE from the chosen item.
1047 If POSITION is nil, don't display the menu at all, just precalculate the
1048 cached information about equivalent key sequences.
1050 If the user gets rid of the menu without making a valid choice, for
1051 instance by clicking the mouse away from a valid choice or by typing
1052 keyboard input, then this normally results in a quit and
1053 `x-popup-menu' does not return. But if POSITION is a mouse button
1054 event (indicating that the user invoked the menu with the mouse) then
1055 no quit occurs and `x-popup-menu' returns nil. */)
1056 (Lisp_Object position
, Lisp_Object menu
)
1058 Lisp_Object keymap
, tem
;
1059 int xpos
= 0, ypos
= 0;
1061 const char *error_name
= NULL
;
1062 Lisp_Object selection
= Qnil
;
1064 Lisp_Object x
, y
, window
;
1067 ptrdiff_t specpdl_count
= SPECPDL_INDEX ();
1068 struct gcpro gcpro1
;
1070 if (NILP (position
))
1071 /* This is an obsolete call, which wants us to precompute the
1072 keybinding equivalents, but we don't do that any more anyway. */
1077 bool get_current_pos_p
= 0;
1079 check_window_system (SELECTED_FRAME ());
1081 /* Decode the first argument: find the window and the coordinates. */
1082 if (EQ (position
, Qt
)
1083 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
1084 || EQ (XCAR (position
), Qtool_bar
))))
1086 get_current_pos_p
= 1;
1090 tem
= Fcar (position
);
1093 window
= Fcar (Fcdr (position
));
1095 y
= Fcar (XCDR (tem
));
1100 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1101 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1102 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
1107 /* If a click happens in an external tool bar or a detached
1108 tool bar, x and y is NIL. In that case, use the current
1109 mouse position. This happens for the help button in the
1110 tool bar. Ideally popup-menu should pass NIL to
1111 this function, but it doesn't. */
1112 if (NILP (x
) && NILP (y
))
1113 get_current_pos_p
= 1;
1116 if (get_current_pos_p
)
1118 /* Use the mouse's current position. */
1119 FRAME_PTR new_f
= SELECTED_FRAME ();
1120 #ifdef HAVE_X_WINDOWS
1121 /* Can't use mouse_position_hook for X since it returns
1122 coordinates relative to the window the mouse is in,
1123 we need coordinates relative to the edit widget always. */
1128 mouse_position_for_popup (new_f
, &cur_x
, &cur_y
);
1129 /* cur_x/y may be negative, so use make_number. */
1130 x
= make_number (cur_x
);
1131 y
= make_number (cur_y
);
1134 #else /* not HAVE_X_WINDOWS */
1135 Lisp_Object bar_window
;
1136 enum scroll_bar_part part
;
1138 void (*mouse_position_hook
) (struct frame
**, int,
1140 enum scroll_bar_part
*,
1144 FRAME_TERMINAL (new_f
)->mouse_position_hook
;
1146 if (mouse_position_hook
)
1147 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
1148 &part
, &x
, &y
, &time
);
1149 #endif /* not HAVE_X_WINDOWS */
1152 XSETFRAME (window
, new_f
);
1155 window
= selected_window
;
1161 /* Decode where to put the menu. */
1163 if (FRAMEP (window
))
1165 f
= XFRAME (window
);
1169 else if (WINDOWP (window
))
1171 struct window
*win
= XWINDOW (window
);
1172 CHECK_LIVE_WINDOW (window
);
1173 f
= XFRAME (WINDOW_FRAME (win
));
1175 xpos
= WINDOW_LEFT_EDGE_X (win
);
1176 ypos
= WINDOW_TOP_EDGE_Y (win
);
1179 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1180 but I don't want to make one now. */
1181 CHECK_WINDOW (window
);
1183 CHECK_RANGED_INTEGER (x
,
1184 (xpos
< INT_MIN
- MOST_NEGATIVE_FIXNUM
1185 ? (EMACS_INT
) INT_MIN
- xpos
1186 : MOST_NEGATIVE_FIXNUM
),
1188 CHECK_RANGED_INTEGER (y
,
1189 (ypos
< INT_MIN
- MOST_NEGATIVE_FIXNUM
1190 ? (EMACS_INT
) INT_MIN
- ypos
1191 : MOST_NEGATIVE_FIXNUM
),
1196 /* FIXME: Find a more general check! */
1197 if (!(FRAME_X_P (f
) || FRAME_MSDOS_P (f
)
1198 || FRAME_W32_P (f
) || FRAME_NS_P (f
)))
1199 error ("Can not put GUI menu on this terminal");
1201 XSETFRAME (Vmenu_updating_frame
, f
);
1203 #endif /* HAVE_MENUS */
1205 /* Now parse the lisp menus. */
1206 record_unwind_protect_void (unuse_menu_items
);
1211 /* Decode the menu items from what was specified. */
1213 keymap
= get_keymap (menu
, 0, 0);
1216 /* We were given a keymap. Extract menu info from the keymap. */
1219 /* Extract the detailed info to make one pane. */
1220 keymap_panes (&menu
, 1);
1222 /* Search for a string appearing directly as an element of the keymap.
1223 That string is the title of the menu. */
1224 prompt
= Fkeymap_prompt (keymap
);
1227 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1229 title
= build_string ("Select");
1232 /* Make that be the pane title of the first pane. */
1233 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
1234 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
1238 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
1240 /* We were given a list of keymaps. */
1241 EMACS_INT nmaps
= XFASTINT (Flength (menu
));
1246 SAFE_ALLOCA_LISP (maps
, nmaps
);
1249 /* The first keymap that has a prompt string
1250 supplies the menu title. */
1251 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
1255 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
1257 prompt
= Fkeymap_prompt (keymap
);
1258 if (NILP (title
) && !NILP (prompt
))
1262 /* Extract the detailed info to make one pane. */
1263 keymap_panes (maps
, nmaps
);
1265 /* Make the title be the pane title of the first pane. */
1266 if (!NILP (title
) && menu_items_n_panes
>= 0)
1267 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
1275 /* We were given an old-fashioned menu. */
1276 title
= Fcar (menu
);
1277 CHECK_STRING (title
);
1279 list_of_panes (Fcdr (menu
));
1284 unbind_to (specpdl_count
, Qnil
);
1287 #ifdef HAVE_WINDOW_SYSTEM
1288 /* Hide a previous tip, if any. */
1292 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1293 /* If resources from a previous popup menu still exist, does nothing
1294 until the `menu_free_timer' has freed them (see w32fns.c). This
1295 can occur if you press ESC or click outside a menu without selecting
1298 if (current_popup_menu
)
1300 discard_menu_items ();
1301 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1307 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1308 record_unwind_protect_void (discard_menu_items
);
1311 /* Display them in a menu. */
1314 /* FIXME: Use a terminal hook! */
1315 #if defined HAVE_NTGUI
1316 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
1317 keymaps
, title
, &error_name
);
1318 #elif defined HAVE_NS
1319 selection
= ns_menu_show (f
, xpos
, ypos
, for_click
,
1320 keymaps
, title
, &error_name
);
1321 #else /* MSDOS and X11 */
1322 /* Assume last_event_timestamp is the timestamp of the button event.
1323 Is this assumption ever violated? We can't use the timestamp
1324 stored within POSITION because there the top bits from the actual
1325 timestamp may be truncated away (Bug#4930). */
1326 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
1327 keymaps
, title
, &error_name
,
1328 last_event_timestamp
);
1334 unbind_to (specpdl_count
, Qnil
);
1336 discard_menu_items ();
1339 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1340 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1343 #endif /* HAVE_MENUS */
1347 if (error_name
) error ("%s", error_name
);
1354 staticpro (&menu_items
);
1356 menu_items_inuse
= Qnil
;
1358 defsubr (&Sx_popup_menu
);