1 /* Platform-independent code for terminal communications.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
29 #include "termhooks.h"
30 #include "blockinput.h"
31 #include "dispextern.h"
34 #include "../lwlib/lwlib.h"
52 extern AppendMenuW_Proc unicode_append_menu
;
53 extern HMENU current_popup_menu
;
55 #endif /* HAVE_NTGUI */
59 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
60 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
64 extern Lisp_Object QCtoggle
, QCradio
;
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 Lisp_Object menu_items_inuse
;
72 /* Number of slots currently allocated in menu_items. */
73 int menu_items_allocated
;
75 /* This is the index in menu_items of the first empty slot. */
78 /* The number of panes currently recorded in menu_items,
79 excluding those within submenus. */
80 int menu_items_n_panes
;
82 /* Current depth within submenus. */
83 static int menu_items_submenu_depth
;
88 if (!NILP (menu_items_inuse
))
89 error ("Trying to use a menu from within a menu-entry");
91 if (NILP (menu_items
))
93 menu_items_allocated
= 60;
94 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
97 menu_items_inuse
= Qt
;
99 menu_items_n_panes
= 0;
100 menu_items_submenu_depth
= 0;
103 /* Call at the end of generating the data in menu_items. */
111 unuse_menu_items (dummy
)
114 return menu_items_inuse
= Qnil
;
117 /* Call when finished using the data for the current menu
121 discard_menu_items ()
123 /* Free the structure if it is especially large.
124 Otherwise, hold on to it, to save time. */
125 if (menu_items_allocated
> 200)
128 menu_items_allocated
= 0;
130 xassert (NILP (menu_items_inuse
));
134 cleanup_popup_menu (Lisp_Object arg
)
136 discard_menu_items ();
140 /* This undoes save_menu_items, and it is called by the specpdl unwind
144 restore_menu_items (saved
)
147 menu_items
= XCAR (saved
);
148 menu_items_inuse
= (! NILP (menu_items
) ? Qt
: Qnil
);
149 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
150 saved
= XCDR (saved
);
151 menu_items_used
= XINT (XCAR (saved
));
152 saved
= XCDR (saved
);
153 menu_items_n_panes
= XINT (XCAR (saved
));
154 saved
= XCDR (saved
);
155 menu_items_submenu_depth
= XINT (XCAR (saved
));
159 /* Push the whole state of menu_items processing onto the specpdl.
160 It will be restored when the specpdl is unwound. */
165 Lisp_Object saved
= list4 (!NILP (menu_items_inuse
) ? menu_items
: Qnil
,
166 make_number (menu_items_used
),
167 make_number (menu_items_n_panes
),
168 make_number (menu_items_submenu_depth
));
169 record_unwind_protect (restore_menu_items
, saved
);
170 menu_items_inuse
= Qnil
;
175 /* Make the menu_items vector twice as large. */
180 menu_items_allocated
*= 2;
181 menu_items
= larger_vector (menu_items
, menu_items_allocated
, Qnil
);
184 /* Begin a submenu. */
187 push_submenu_start ()
189 if (menu_items_used
+ 1 > menu_items_allocated
)
192 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
193 menu_items_submenu_depth
++;
201 if (menu_items_used
+ 1 > menu_items_allocated
)
204 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
205 menu_items_submenu_depth
--;
208 /* Indicate boundary between left and right. */
211 push_left_right_boundary ()
213 if (menu_items_used
+ 1 > menu_items_allocated
)
216 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
219 /* Start a new menu pane in menu_items.
220 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
223 push_menu_pane (name
, prefix_vec
)
224 Lisp_Object name
, prefix_vec
;
226 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
229 if (menu_items_submenu_depth
== 0)
230 menu_items_n_panes
++;
231 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
232 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
233 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
236 /* Push one menu item into the current pane. NAME is the string to
237 display. ENABLE if non-nil means this item can be selected. KEY
238 is the key generated by choosing this item, or nil if this item
239 doesn't really have a definition. DEF is the definition of this
240 item. EQUIV is the textual description of the keyboard equivalent
241 for this item (or nil if none). TYPE is the type of this menu
242 item, one of nil, `toggle' or `radio'. */
245 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
246 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
248 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
251 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_NAME
, name
);
252 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_ENABLE
, enable
);
253 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_VALUE
, key
);
254 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_EQUIV_KEY
, equiv
);
255 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_DEFINITION
, def
);
256 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_TYPE
, type
);
257 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_SELECTED
, selected
);
258 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_HELP
, help
);
260 menu_items_used
+= MENU_ITEMS_ITEM_LENGTH
;
263 /* Args passed between single_keymap_panes and single_menu_item. */
266 Lisp_Object pending_maps
;
271 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
274 /* This is a recursive subroutine of keymap_panes.
275 It handles one keymap, KEYMAP.
276 The other arguments are passed along
277 or point to local variables of the previous function.
279 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
282 single_keymap_panes (Lisp_Object keymap
, Lisp_Object pane_name
,
283 Lisp_Object prefix
, int maxdepth
)
288 skp
.pending_maps
= Qnil
;
289 skp
.maxdepth
= maxdepth
;
295 push_menu_pane (pane_name
, prefix
);
298 /* Remember index for first item in this pane so we can go back and
299 add a prefix when (if) we see the first button. After that, notbuttons
300 is set to 0, to mark that we have seen a button and all non button
301 items need a prefix. */
302 skp
.notbuttons
= menu_items_used
;
305 GCPRO1 (skp
.pending_maps
);
306 map_keymap_canonical (keymap
, single_menu_item
, Qnil
, &skp
);
309 /* Process now any submenus which want to be panes at this level. */
310 while (CONSP (skp
.pending_maps
))
312 Lisp_Object elt
, eltcdr
, string
;
313 elt
= XCAR (skp
.pending_maps
);
315 string
= XCAR (eltcdr
);
316 /* We no longer discard the @ from the beginning of the string here.
317 Instead, we do this in *menu_show. */
318 single_keymap_panes (Fcar (elt
), string
, XCDR (eltcdr
), maxdepth
- 1);
319 skp
.pending_maps
= XCDR (skp
.pending_maps
);
323 /* This is a subroutine of single_keymap_panes that handles one
325 KEY is a key in a keymap and ITEM is its binding.
326 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
328 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
331 single_menu_item (key
, item
, dummy
, skp_v
)
332 Lisp_Object key
, item
, dummy
;
335 Lisp_Object map
, item_string
, enabled
;
336 struct gcpro gcpro1
, gcpro2
;
338 struct skp
*skp
= skp_v
;
340 /* Parse the menu item and leave the result in item_properties. */
342 res
= parse_menu_item (item
, 0);
345 return; /* Not a menu item. */
347 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
349 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
350 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
352 if (!NILP (map
) && SREF (item_string
, 0) == '@')
355 /* An enabled separate pane. Remember this to handle it later. */
356 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
361 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
363 /* Simulate radio buttons and toggle boxes by putting a prefix in
366 Lisp_Object prefix
= Qnil
;
367 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
371 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
374 /* The first button. Line up previous items in this menu. */
376 int index
= skp
->notbuttons
; /* Index for first item this menu. */
379 while (index
< menu_items_used
)
382 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
386 submenu
++; /* Skip sub menu. */
388 else if (EQ (tem
, Qlambda
))
391 submenu
--; /* End sub menu. */
393 else if (EQ (tem
, Qt
))
394 index
+= 3; /* Skip new pane marker. */
395 else if (EQ (tem
, Qquote
))
396 index
++; /* Skip a left, right divider. */
399 if (!submenu
&& SREF (tem
, 0) != '\0'
400 && SREF (tem
, 0) != '-')
401 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
402 = concat2 (build_string (" "), tem
);
403 index
+= MENU_ITEMS_ITEM_LENGTH
;
409 /* Calculate prefix, if any, for this item. */
410 if (EQ (type
, QCtoggle
))
411 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
412 else if (EQ (type
, QCradio
))
413 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
415 /* Not a button. If we have earlier buttons, then we need a prefix. */
416 else if (!skp
->notbuttons
&& SREF (item_string
, 0) != '\0'
417 && SREF (item_string
, 0) != '-')
418 prefix
= build_string (" ");
421 item_string
= concat2 (prefix
, item_string
);
423 #endif /* not HAVE_BOXES */
425 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
427 /* Indicate visually that this is a submenu. */
428 item_string
= concat2 (item_string
, build_string (" >"));
431 #endif /* HAVE_X_WINDOWS || MSDOS */
433 push_menu_item (item_string
, enabled
, key
,
434 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
435 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
436 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
437 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
438 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
440 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
441 /* Display a submenu using the toolkit. */
442 if (! (NILP (map
) || NILP (enabled
)))
444 push_submenu_start ();
445 single_keymap_panes (map
, Qnil
, key
, skp
->maxdepth
- 1);
451 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
452 and generate menu panes for them in menu_items. */
455 keymap_panes (keymaps
, nmaps
)
456 Lisp_Object
*keymaps
;
463 /* Loop over the given keymaps, making a pane for each map.
464 But don't make a pane that is empty--ignore that map instead.
465 P is the number of panes we have made so far. */
466 for (mapno
= 0; mapno
< nmaps
; mapno
++)
467 single_keymap_panes (keymaps
[mapno
],
468 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, 10);
470 finish_menu_items ();
474 /* Push the items in a single pane defined by the alist PANE. */
479 Lisp_Object tail
, item
, item1
;
481 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
485 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
486 Qnil
, Qnil
, Qnil
, Qnil
);
487 else if (CONSP (item
))
490 CHECK_STRING (item1
);
491 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
492 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
495 push_left_right_boundary ();
500 /* Push all the panes and items of a menu described by the
501 alist-of-alists MENU.
502 This handles old-fashioned calls to x-popup-menu. */
511 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
513 Lisp_Object elt
, pane_name
, pane_data
;
515 pane_name
= Fcar (elt
);
516 CHECK_STRING (pane_name
);
517 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
518 pane_data
= Fcdr (elt
);
519 CHECK_CONS (pane_data
);
520 list_of_items (pane_data
);
523 finish_menu_items ();
526 /* Set up data in menu_items for a menu bar item
527 whose event type is ITEM_KEY (with string ITEM_NAME)
528 and whose contents come from the list of keymaps MAPS. */
530 parse_single_submenu (item_key
, item_name
, maps
)
531 Lisp_Object item_key
, item_name
, maps
;
537 int top_level_items
= 0;
539 length
= Flength (maps
);
542 /* Convert the list MAPS into a vector MAPVEC. */
543 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
544 for (i
= 0; i
< len
; i
++)
546 mapvec
[i
] = Fcar (maps
);
550 /* Loop over the given keymaps, making a pane for each map.
551 But don't make a pane that is empty--ignore that map instead. */
552 for (i
= 0; i
< len
; i
++)
554 if (!KEYMAPP (mapvec
[i
]))
556 /* Here we have a command at top level in the menu bar
557 as opposed to a submenu. */
559 push_menu_pane (Qnil
, Qnil
);
560 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
561 Qnil
, Qnil
, Qnil
, Qnil
);
566 prompt
= Fkeymap_prompt (mapvec
[i
]);
567 single_keymap_panes (mapvec
[i
],
568 !NILP (prompt
) ? prompt
: item_name
,
573 return top_level_items
;
577 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
579 /* Allocate a widget_value, blocking input. */
582 xmalloc_widget_value ()
587 value
= malloc_widget_value ();
593 /* This recursively calls free_widget_value on the tree of widgets.
594 It must free all data that was malloc'ed for these widget_values.
595 In Emacs, many slots are pointers into the data of Lisp_Strings, and
596 must be left alone. */
599 free_menubar_widget_value_tree (wv
)
604 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
606 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
608 free_menubar_widget_value_tree (wv
->contents
);
609 wv
->contents
= (widget_value
*) 0xDEADBEEF;
613 free_menubar_widget_value_tree (wv
->next
);
614 wv
->next
= (widget_value
*) 0xDEADBEEF;
617 free_widget_value (wv
);
621 /* Create a tree of widget_value objects
622 representing the panes and items
623 in menu_items starting at index START, up to index END. */
626 digest_single_submenu (start
, end
, top_level_items
)
627 int start
, end
, 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 (XVECTOR (menu_items
)->contents
[i
], Qnil
))
656 submenu_stack
[submenu_depth
++] = save_wv
;
661 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
664 save_wv
= submenu_stack
[--submenu_depth
];
667 else if (EQ (XVECTOR (menu_items
)->contents
[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 (XVECTOR (menu_items
)->contents
[i
], Qquote
))
674 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
676 /* Create a new pane. */
677 Lisp_Object pane_name
, prefix
;
682 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
683 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
686 if (STRINGP (pane_name
))
688 if (unicode_append_menu
)
689 /* Encode as UTF-8 for now. */
690 pane_name
= ENCODE_UTF_8 (pane_name
);
691 else if (STRING_MULTIBYTE (pane_name
))
692 pane_name
= ENCODE_SYSTEM (pane_name
);
694 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
696 #elif !defined (HAVE_MULTILINGUAL_MENU)
697 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
699 pane_name
= ENCODE_MENU_STRING (pane_name
);
700 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
704 pane_string
= (NILP (pane_name
)
705 ? "" : (char *) SDATA (pane_name
));
706 /* If there is just one top-level pane, put all its items directly
707 under the top-level menu. */
708 if (menu_items_n_panes
== 1)
711 /* If the pane has a meaningful name,
712 make the pane a top-level menu item
713 with its items as a submenu beneath it. */
714 if (strcmp (pane_string
, ""))
716 wv
= xmalloc_widget_value ();
720 first_wv
->contents
= wv
;
721 wv
->lname
= pane_name
;
722 /* Set value to 1 so update_submenu_strings can handle '@' */
723 wv
->value
= (char *)1;
725 wv
->button_type
= BUTTON_TYPE_NONE
;
733 i
+= MENU_ITEMS_PANE_LENGTH
;
737 /* Create a new item within current pane. */
738 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
741 /* All items should be contained in panes. */
745 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
746 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
747 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
748 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
749 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
750 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
751 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
754 if (STRINGP (item_name
))
756 if (unicode_append_menu
)
757 item_name
= ENCODE_UTF_8 (item_name
);
758 else if (STRING_MULTIBYTE (item_name
))
759 item_name
= ENCODE_SYSTEM (item_name
);
761 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
764 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
766 descrip
= ENCODE_SYSTEM (descrip
);
767 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
769 #elif !defined (HAVE_MULTILINGUAL_MENU)
770 if (STRING_MULTIBYTE (item_name
))
772 item_name
= ENCODE_MENU_STRING (item_name
);
773 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
776 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
778 descrip
= ENCODE_MENU_STRING (descrip
);
779 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
783 wv
= xmalloc_widget_value ();
787 save_wv
->contents
= wv
;
789 wv
->lname
= item_name
;
793 /* The EMACS_INT cast avoids a warning. There's no problem
794 as long as pointers have enough bits to hold small integers. */
795 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
796 wv
->enabled
= !NILP (enable
);
799 wv
->button_type
= BUTTON_TYPE_NONE
;
800 else if (EQ (type
, QCradio
))
801 wv
->button_type
= BUTTON_TYPE_RADIO
;
802 else if (EQ (type
, QCtoggle
))
803 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
807 wv
->selected
= !NILP (selected
);
808 if (! STRINGP (help
))
815 i
+= MENU_ITEMS_ITEM_LENGTH
;
819 /* If we have just one "menu item"
820 that was originally a button, return it by itself. */
821 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
823 wv
= first_wv
->contents
;
824 free_widget_value (first_wv
);
831 /* Walk through the widget_value tree starting at FIRST_WV and update
832 the char * pointers from the corresponding lisp values.
833 We do this after building the whole tree, since GC may happen while the
834 tree is constructed, and small strings are relocated. So we must wait
835 until no GC can happen before storing pointers into lisp values. */
837 update_submenu_strings (first_wv
)
838 widget_value
*first_wv
;
842 for (wv
= first_wv
; wv
; wv
= wv
->next
)
844 if (STRINGP (wv
->lname
))
846 wv
->name
= (char *) SDATA (wv
->lname
);
848 /* Ignore the @ that means "separate pane".
849 This is a kludge, but this isn't worth more time. */
850 if (wv
->value
== (char *)1)
852 if (wv
->name
[0] == '@')
858 if (STRINGP (wv
->lkey
))
859 wv
->key
= (char *) SDATA (wv
->lkey
);
862 update_submenu_strings (wv
->contents
);
866 /* Find the menu selection and store it in the keyboard buffer.
867 F is the frame the menu is on.
868 MENU_BAR_ITEMS_USED is the length of VECTOR.
869 VECTOR is an array of menu events for the whole menu. */
872 find_and_call_menu_selection (f
, menu_bar_items_used
, vector
, client_data
)
874 int menu_bar_items_used
;
878 Lisp_Object prefix
, entry
;
879 Lisp_Object
*subprefix_stack
;
880 int submenu_depth
= 0;
884 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
888 while (i
< menu_bar_items_used
)
890 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
892 subprefix_stack
[submenu_depth
++] = prefix
;
896 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
898 prefix
= subprefix_stack
[--submenu_depth
];
901 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
903 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
904 i
+= MENU_ITEMS_PANE_LENGTH
;
908 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
909 /* The EMACS_INT cast avoids a warning. There's no problem
910 as long as pointers have enough bits to hold small integers. */
911 if ((int) (EMACS_INT
) client_data
== i
)
914 struct input_event buf
;
918 XSETFRAME (frame
, f
);
919 buf
.kind
= MENU_BAR_EVENT
;
920 buf
.frame_or_window
= frame
;
922 kbd_buffer_store_event (&buf
);
924 for (j
= 0; j
< submenu_depth
; j
++)
925 if (!NILP (subprefix_stack
[j
]))
927 buf
.kind
= MENU_BAR_EVENT
;
928 buf
.frame_or_window
= frame
;
929 buf
.arg
= subprefix_stack
[j
];
930 kbd_buffer_store_event (&buf
);
935 buf
.kind
= MENU_BAR_EVENT
;
936 buf
.frame_or_window
= frame
;
938 kbd_buffer_store_event (&buf
);
941 buf
.kind
= MENU_BAR_EVENT
;
942 buf
.frame_or_window
= frame
;
944 kbd_buffer_store_event (&buf
);
948 i
+= MENU_ITEMS_ITEM_LENGTH
;
953 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
956 /* As above, but return the menu selection instead of storing in kb buffer.
957 If keymaps==1, return full prefixes to selection. */
959 find_and_return_menu_selection (FRAME_PTR f
, int keymaps
, void *client_data
)
961 Lisp_Object prefix
, entry
;
963 Lisp_Object
*subprefix_stack
;
964 int submenu_depth
= 0;
966 prefix
= entry
= Qnil
;
969 (Lisp_Object
*)alloca(menu_items_used
* sizeof (Lisp_Object
));
971 while (i
< menu_items_used
)
973 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
975 subprefix_stack
[submenu_depth
++] = prefix
;
979 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
981 prefix
= subprefix_stack
[--submenu_depth
];
984 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
987 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
988 i
+= MENU_ITEMS_PANE_LENGTH
;
990 /* Ignore a nil in the item list.
991 It's meaningful only for dialog boxes. */
992 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
997 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
998 if ((EMACS_INT
)client_data
== (EMACS_INT
)(&XVECTOR (menu_items
)->contents
[i
]))
1004 entry
= Fcons (entry
, Qnil
);
1006 entry
= Fcons (prefix
, entry
);
1007 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1008 if (!NILP (subprefix_stack
[j
]))
1009 entry
= Fcons (subprefix_stack
[j
], entry
);
1013 i
+= MENU_ITEMS_ITEM_LENGTH
;
1018 #endif /* HAVE_NS */
1020 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
1021 doc
: /* Pop up a deck-of-cards menu and return user's selection.
1022 POSITION is a position specification. This is either a mouse button event
1023 or a list ((XOFFSET YOFFSET) WINDOW)
1024 where XOFFSET and YOFFSET are positions in pixels from the top left
1025 corner of WINDOW. (WINDOW may be a window or a frame object.)
1026 This controls the position of the top left of the menu as a whole.
1027 If POSITION is t, it means to use the current mouse position.
1029 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1030 The menu items come from key bindings that have a menu string as well as
1031 a definition; actually, the "definition" in such a key binding looks like
1032 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1033 the keymap as a top-level element.
1035 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1036 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1038 You can also use a list of keymaps as MENU.
1039 Then each keymap makes a separate pane.
1041 When MENU is a keymap or a list of keymaps, the return value is the
1042 list of events corresponding to the user's choice. Note that
1043 `x-popup-menu' does not actually execute the command bound to that
1046 Alternatively, you can specify a menu of multiple panes
1047 with a list of the form (TITLE PANE1 PANE2...),
1048 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1049 Each ITEM is normally a cons cell (STRING . VALUE);
1050 but a string can appear as an item--that makes a nonselectable line
1052 With this form of menu, the return value is VALUE from the chosen item.
1054 If POSITION is nil, don't display the menu at all, just precalculate the
1055 cached information about equivalent key sequences.
1057 If the user gets rid of the menu without making a valid choice, for
1058 instance by clicking the mouse away from a valid choice or by typing
1059 keyboard input, then this normally results in a quit and
1060 `x-popup-menu' does not return. But if POSITION is a mouse button
1061 event (indicating that the user invoked the menu with the mouse) then
1062 no quit occurs and `x-popup-menu' returns nil. */)
1064 Lisp_Object position
, menu
;
1066 Lisp_Object keymap
, tem
;
1067 int xpos
= 0, ypos
= 0;
1069 char *error_name
= NULL
;
1070 Lisp_Object selection
= Qnil
;
1072 Lisp_Object x
, y
, window
;
1075 int specpdl_count
= SPECPDL_INDEX ();
1076 Lisp_Object timestamp
= Qnil
;
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
= Fcdr (Fcdr (tem
));
1111 x
= Fcar (Fcar (tem
));
1112 y
= Fcdr (Fcar (tem
));
1113 timestamp
= Fcar (Fcdr (tem
));
1116 /* If a click happens in an external tool bar or a detached
1117 tool bar, x and y is NIL. In that case, use the current
1118 mouse position. This happens for the help button in the
1119 tool bar. Ideally popup-menu should pass NIL to
1120 this function, but it doesn't. */
1121 if (NILP (x
) && NILP (y
))
1122 get_current_pos_p
= 1;
1125 if (get_current_pos_p
)
1127 /* Use the mouse's current position. */
1128 FRAME_PTR new_f
= SELECTED_FRAME ();
1129 #ifdef HAVE_X_WINDOWS
1130 /* Can't use mouse_position_hook for X since it returns
1131 coordinates relative to the window the mouse is in,
1132 we need coordinates relative to the edit widget always. */
1137 mouse_position_for_popup (new_f
, &cur_x
, &cur_y
);
1138 /* cur_x/y may be negative, so use make_number. */
1139 x
= make_number (cur_x
);
1140 y
= make_number (cur_y
);
1143 #else /* not HAVE_X_WINDOWS */
1144 Lisp_Object bar_window
;
1145 enum scroll_bar_part part
;
1147 void (*mouse_position_hook
) P_ ((struct frame
**, int,
1149 enum scroll_bar_part
*,
1153 FRAME_TERMINAL (new_f
)->mouse_position_hook
;
1155 if (mouse_position_hook
)
1156 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
1157 &part
, &x
, &y
, &time
);
1158 #endif /* not HAVE_X_WINDOWS */
1161 XSETFRAME (window
, new_f
);
1164 window
= selected_window
;
1173 /* Decode where to put the menu. */
1175 if (FRAMEP (window
))
1177 f
= XFRAME (window
);
1181 else if (WINDOWP (window
))
1183 struct window
*win
= XWINDOW (window
);
1184 CHECK_LIVE_WINDOW (window
);
1185 f
= XFRAME (WINDOW_FRAME (win
));
1187 xpos
= WINDOW_LEFT_EDGE_X (win
);
1188 ypos
= WINDOW_TOP_EDGE_Y (win
);
1191 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1192 but I don't want to make one now. */
1193 CHECK_WINDOW (window
);
1198 /* FIXME: Find a more general check! */
1199 if (!(FRAME_X_P (f
) || FRAME_MSDOS_P (f
)
1200 || FRAME_W32_P (f
) || FRAME_NS_P (f
)))
1201 error ("Can not put GUI menu on this terminal");
1203 XSETFRAME (Vmenu_updating_frame
, f
);
1205 #endif /* HAVE_MENUS */
1207 /* Now parse the lisp menus. */
1208 record_unwind_protect (unuse_menu_items
, Qnil
);
1213 /* Decode the menu items from what was specified. */
1215 keymap
= get_keymap (menu
, 0, 0);
1218 /* We were given a keymap. Extract menu info from the keymap. */
1221 /* Extract the detailed info to make one pane. */
1222 keymap_panes (&menu
, 1);
1224 /* Search for a string appearing directly as an element of the keymap.
1225 That string is the title of the menu. */
1226 prompt
= Fkeymap_prompt (keymap
);
1229 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1231 title
= build_string ("Select");
1234 /* Make that be the pane title of the first pane. */
1235 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
1236 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
1240 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
1242 /* We were given a list of keymaps. */
1243 int nmaps
= XFASTINT (Flength (menu
));
1245 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
1250 /* The first keymap that has a prompt string
1251 supplies the menu title. */
1252 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
1256 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
1258 prompt
= Fkeymap_prompt (keymap
);
1259 if (NILP (title
) && !NILP (prompt
))
1263 /* Extract the detailed info to make one pane. */
1264 keymap_panes (maps
, nmaps
);
1266 /* Make the title be the pane title of the first pane. */
1267 if (!NILP (title
) && menu_items_n_panes
>= 0)
1268 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
1274 /* We were given an old-fashioned menu. */
1275 title
= Fcar (menu
);
1276 CHECK_STRING (title
);
1278 list_of_panes (Fcdr (menu
));
1283 unbind_to (specpdl_count
, Qnil
);
1286 #ifdef HAVE_WINDOW_SYSTEM
1287 /* Hide a previous tip, if any. */
1291 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1292 /* If resources from a previous popup menu still exist, does nothing
1293 until the `menu_free_timer' has freed them (see w32fns.c). This
1294 can occur if you press ESC or click outside a menu without selecting
1297 if (current_popup_menu
)
1299 discard_menu_items ();
1300 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1306 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1307 record_unwind_protect (cleanup_popup_menu
, Qnil
);
1310 /* Display them in a menu. */
1313 /* FIXME: Use a terminal hook! */
1314 #if defined HAVE_NTGUI
1315 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
1316 keymaps
, title
, &error_name
);
1317 #elif defined HAVE_NS
1318 selection
= ns_menu_show (f
, xpos
, ypos
, for_click
,
1319 keymaps
, title
, &error_name
);
1320 #else /* MSDOS and X11 */
1321 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
1322 keymaps
, title
, &error_name
,
1323 INTEGERP (timestamp
) ? XUINT (timestamp
) : 0);
1329 unbind_to (specpdl_count
, Qnil
);
1331 discard_menu_items ();
1334 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1335 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1338 #endif /* HAVE_MENUS */
1342 if (error_name
) error (error_name
);
1349 staticpro (&menu_items
);
1351 menu_items_inuse
= Qnil
;
1353 defsubr (&Sx_popup_menu
);
1356 /* arch-tag: 78bbc7cf-8025-4156-aa8a-6c7fd99bf51d
1357 (do not change this comment) */