1 /* Platform-independent code for terminal communications.
3 Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2011
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/>. */
30 #include "termhooks.h"
31 #include "blockinput.h"
32 #include "dispextern.h"
35 #include "../lwlib/lwlib.h"
53 extern AppendMenuW_Proc unicode_append_menu
;
54 extern HMENU current_popup_menu
;
56 #endif /* HAVE_NTGUI */
60 /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
61 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
65 Lisp_Object menu_items
;
67 /* If non-nil, means that the global vars defined here are already in use.
68 Used to detect cases where we try to re-enter this non-reentrant code. */
69 Lisp_Object menu_items_inuse
;
71 /* Number of slots currently allocated in menu_items. */
72 int menu_items_allocated
;
74 /* This is the index in menu_items of the first empty slot. */
77 /* The number of panes currently recorded in menu_items,
78 excluding those within submenus. */
79 int menu_items_n_panes
;
81 /* Current depth within submenus. */
82 static int menu_items_submenu_depth
;
85 init_menu_items (void)
87 if (!NILP (menu_items_inuse
))
88 error ("Trying to use a menu from within a menu-entry");
90 if (NILP (menu_items
))
92 menu_items_allocated
= 60;
93 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
96 menu_items_inuse
= Qt
;
98 menu_items_n_panes
= 0;
99 menu_items_submenu_depth
= 0;
102 /* Call at the end of generating the data in menu_items. */
105 finish_menu_items (void)
110 unuse_menu_items (Lisp_Object dummy
)
112 return menu_items_inuse
= Qnil
;
115 /* Call when finished using the data for the current menu
119 discard_menu_items (void)
121 /* Free the structure if it is especially large.
122 Otherwise, hold on to it, to save time. */
123 if (menu_items_allocated
> 200)
126 menu_items_allocated
= 0;
128 xassert (NILP (menu_items_inuse
));
133 cleanup_popup_menu (Lisp_Object arg
)
135 discard_menu_items ();
140 /* This undoes save_menu_items, and it is called by the specpdl unwind
144 restore_menu_items (Lisp_Object saved
)
146 menu_items
= XCAR (saved
);
147 menu_items_inuse
= (! NILP (menu_items
) ? Qt
: Qnil
);
148 menu_items_allocated
= (VECTORP (menu_items
) ? ASIZE (menu_items
) : 0);
149 saved
= XCDR (saved
);
150 menu_items_used
= XINT (XCAR (saved
));
151 saved
= XCDR (saved
);
152 menu_items_n_panes
= XINT (XCAR (saved
));
153 saved
= XCDR (saved
);
154 menu_items_submenu_depth
= XINT (XCAR (saved
));
158 /* Push the whole state of menu_items processing onto the specpdl.
159 It will be restored when the specpdl is unwound. */
162 save_menu_items (void)
164 Lisp_Object saved
= list4 (!NILP (menu_items_inuse
) ? menu_items
: Qnil
,
165 make_number (menu_items_used
),
166 make_number (menu_items_n_panes
),
167 make_number (menu_items_submenu_depth
));
168 record_unwind_protect (restore_menu_items
, saved
);
169 menu_items_inuse
= Qnil
;
174 /* Make the menu_items vector twice as large. */
177 grow_menu_items (void)
179 menu_items_allocated
*= 2;
180 menu_items
= larger_vector (menu_items
, menu_items_allocated
, Qnil
);
183 /* Begin a submenu. */
186 push_submenu_start (void)
188 if (menu_items_used
+ 1 > menu_items_allocated
)
191 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
192 menu_items_submenu_depth
++;
198 push_submenu_end (void)
200 if (menu_items_used
+ 1 > menu_items_allocated
)
203 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
204 menu_items_submenu_depth
--;
207 /* Indicate boundary between left and right. */
210 push_left_right_boundary (void)
212 if (menu_items_used
+ 1 > menu_items_allocated
)
215 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
218 /* Start a new menu pane in menu_items.
219 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
222 push_menu_pane (Lisp_Object name
, Lisp_Object prefix_vec
)
224 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
227 if (menu_items_submenu_depth
== 0)
228 menu_items_n_panes
++;
229 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
230 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
231 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
234 /* Push one menu item into the current pane. NAME is the string to
235 display. ENABLE if non-nil means this item can be selected. KEY
236 is the key generated by choosing this item, or nil if this item
237 doesn't really have a definition. DEF is the definition of this
238 item. EQUIV is the textual description of the keyboard equivalent
239 for this item (or nil if none). TYPE is the type of this menu
240 item, one of nil, `toggle' or `radio'. */
243 push_menu_item (Lisp_Object name
, Lisp_Object enable
, Lisp_Object key
, Lisp_Object def
, Lisp_Object equiv
, Lisp_Object type
, Lisp_Object selected
, Lisp_Object help
)
245 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
248 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_NAME
, name
);
249 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_ENABLE
, enable
);
250 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_VALUE
, key
);
251 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_EQUIV_KEY
, equiv
);
252 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_DEFINITION
, def
);
253 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_TYPE
, type
);
254 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_SELECTED
, selected
);
255 ASET (menu_items
, menu_items_used
+ MENU_ITEMS_ITEM_HELP
, help
);
257 menu_items_used
+= MENU_ITEMS_ITEM_LENGTH
;
260 /* Args passed between single_keymap_panes and single_menu_item. */
263 Lisp_Object pending_maps
;
268 static void single_menu_item (Lisp_Object
, Lisp_Object
, Lisp_Object
,
271 /* This is a recursive subroutine of keymap_panes.
272 It handles one keymap, KEYMAP.
273 The other arguments are passed along
274 or point to local variables of the previous function.
276 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
279 single_keymap_panes (Lisp_Object keymap
, Lisp_Object pane_name
,
280 Lisp_Object prefix
, int maxdepth
)
285 skp
.pending_maps
= Qnil
;
286 skp
.maxdepth
= maxdepth
;
292 push_menu_pane (pane_name
, prefix
);
295 /* Remember index for first item in this pane so we can go back and
296 add a prefix when (if) we see the first button. After that, notbuttons
297 is set to 0, to mark that we have seen a button and all non button
298 items need a prefix. */
299 skp
.notbuttons
= menu_items_used
;
302 GCPRO1 (skp
.pending_maps
);
303 map_keymap_canonical (keymap
, single_menu_item
, Qnil
, &skp
);
306 /* Process now any submenus which want to be panes at this level. */
307 while (CONSP (skp
.pending_maps
))
309 Lisp_Object elt
, eltcdr
, string
;
310 elt
= XCAR (skp
.pending_maps
);
312 string
= XCAR (eltcdr
);
313 /* We no longer discard the @ from the beginning of the string here.
314 Instead, we do this in *menu_show. */
315 single_keymap_panes (Fcar (elt
), string
, XCDR (eltcdr
), maxdepth
- 1);
316 skp
.pending_maps
= XCDR (skp
.pending_maps
);
320 /* This is a subroutine of single_keymap_panes that handles one
322 KEY is a key in a keymap and ITEM is its binding.
323 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
325 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
328 single_menu_item (Lisp_Object key
, Lisp_Object item
, Lisp_Object dummy
, void *skp_v
)
330 Lisp_Object map
, item_string
, enabled
;
331 struct gcpro gcpro1
, gcpro2
;
333 struct skp
*skp
= skp_v
;
335 /* Parse the menu item and leave the result in item_properties. */
337 res
= parse_menu_item (item
, 0);
340 return; /* Not a menu item. */
342 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
344 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
345 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
347 if (!NILP (map
) && SREF (item_string
, 0) == '@')
350 /* An enabled separate pane. Remember this to handle it later. */
351 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
356 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
358 /* Simulate radio buttons and toggle boxes by putting a prefix in
361 Lisp_Object prefix
= Qnil
;
362 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
366 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
369 /* The first button. Line up previous items in this menu. */
371 int index
= skp
->notbuttons
; /* Index for first item this menu. */
374 while (index
< menu_items_used
)
377 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
381 submenu
++; /* Skip sub menu. */
383 else if (EQ (tem
, Qlambda
))
386 submenu
--; /* End sub menu. */
388 else if (EQ (tem
, Qt
))
389 index
+= 3; /* Skip new pane marker. */
390 else if (EQ (tem
, Qquote
))
391 index
++; /* Skip a left, right divider. */
394 if (!submenu
&& SREF (tem
, 0) != '\0'
395 && SREF (tem
, 0) != '-')
396 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
397 = concat2 (build_string (" "), tem
);
398 index
+= MENU_ITEMS_ITEM_LENGTH
;
404 /* Calculate prefix, if any, for this item. */
405 if (EQ (type
, QCtoggle
))
406 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
407 else if (EQ (type
, QCradio
))
408 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
410 /* Not a button. If we have earlier buttons, then we need a prefix. */
411 else if (!skp
->notbuttons
&& SREF (item_string
, 0) != '\0'
412 && SREF (item_string
, 0) != '-')
413 prefix
= build_string (" ");
416 item_string
= concat2 (prefix
, item_string
);
418 #endif /* not HAVE_BOXES */
420 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
422 /* Indicate visually that this is a submenu. */
423 item_string
= concat2 (item_string
, build_string (" >"));
426 #endif /* HAVE_X_WINDOWS || MSDOS */
428 push_menu_item (item_string
, enabled
, key
,
429 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
430 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
431 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
432 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
433 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
435 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
436 /* Display a submenu using the toolkit. */
437 if (! (NILP (map
) || NILP (enabled
)))
439 push_submenu_start ();
440 single_keymap_panes (map
, Qnil
, key
, skp
->maxdepth
- 1);
446 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
447 and generate menu panes for them in menu_items. */
450 keymap_panes (Lisp_Object
*keymaps
, int nmaps
)
456 /* Loop over the given keymaps, making a pane for each map.
457 But don't make a pane that is empty--ignore that map instead.
458 P is the number of panes we have made so far. */
459 for (mapno
= 0; mapno
< nmaps
; mapno
++)
460 single_keymap_panes (keymaps
[mapno
],
461 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, 10);
463 finish_menu_items ();
467 /* Push the items in a single pane defined by the alist PANE. */
469 list_of_items (Lisp_Object pane
)
471 Lisp_Object tail
, item
, item1
;
473 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
477 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
478 Qnil
, Qnil
, Qnil
, Qnil
);
479 else if (CONSP (item
))
482 CHECK_STRING (item1
);
483 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
484 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
487 push_left_right_boundary ();
492 /* Push all the panes and items of a menu described by the
493 alist-of-alists MENU.
494 This handles old-fashioned calls to x-popup-menu. */
496 list_of_panes (Lisp_Object menu
)
502 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
504 Lisp_Object elt
, pane_name
, pane_data
;
506 pane_name
= Fcar (elt
);
507 CHECK_STRING (pane_name
);
508 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
509 pane_data
= Fcdr (elt
);
510 CHECK_CONS (pane_data
);
511 list_of_items (pane_data
);
514 finish_menu_items ();
517 /* Set up data in menu_items for a menu bar item
518 whose event type is ITEM_KEY (with string ITEM_NAME)
519 and whose contents come from the list of keymaps MAPS. */
521 parse_single_submenu (Lisp_Object item_key
, Lisp_Object item_name
, Lisp_Object maps
)
527 int top_level_items
= 0;
529 length
= Flength (maps
);
532 /* Convert the list MAPS into a vector MAPVEC. */
533 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
534 for (i
= 0; i
< len
; i
++)
536 mapvec
[i
] = Fcar (maps
);
540 /* Loop over the given keymaps, making a pane for each map.
541 But don't make a pane that is empty--ignore that map instead. */
542 for (i
= 0; i
< len
; i
++)
544 if (!KEYMAPP (mapvec
[i
]))
546 /* Here we have a command at top level in the menu bar
547 as opposed to a submenu. */
549 push_menu_pane (Qnil
, Qnil
);
550 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
551 Qnil
, Qnil
, Qnil
, Qnil
);
556 prompt
= Fkeymap_prompt (mapvec
[i
]);
557 single_keymap_panes (mapvec
[i
],
558 !NILP (prompt
) ? prompt
: item_name
,
563 return top_level_items
;
567 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
569 /* Allocate a widget_value, blocking input. */
572 xmalloc_widget_value (void)
577 value
= malloc_widget_value ();
583 /* This recursively calls free_widget_value on the tree of widgets.
584 It must free all data that was malloc'ed for these widget_values.
585 In Emacs, many slots are pointers into the data of Lisp_Strings, and
586 must be left alone. */
589 free_menubar_widget_value_tree (widget_value
*wv
)
593 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
595 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
597 free_menubar_widget_value_tree (wv
->contents
);
598 wv
->contents
= (widget_value
*) 0xDEADBEEF;
602 free_menubar_widget_value_tree (wv
->next
);
603 wv
->next
= (widget_value
*) 0xDEADBEEF;
606 free_widget_value (wv
);
610 /* Create a tree of widget_value objects
611 representing the panes and items
612 in menu_items starting at index START, up to index END. */
615 digest_single_submenu (int start
, int end
, int top_level_items
)
617 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
619 int submenu_depth
= 0;
620 widget_value
**submenu_stack
;
624 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
625 wv
= xmalloc_widget_value ();
629 wv
->button_type
= BUTTON_TYPE_NONE
;
635 /* Loop over all panes and items made by the preceding call
636 to parse_single_submenu and construct a tree of widget_value objects.
637 Ignore the panes and items used by previous calls to
638 digest_single_submenu, even though those are also in menu_items. */
642 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
644 submenu_stack
[submenu_depth
++] = save_wv
;
649 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
652 save_wv
= submenu_stack
[--submenu_depth
];
655 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
656 && submenu_depth
!= 0)
657 i
+= MENU_ITEMS_PANE_LENGTH
;
658 /* Ignore a nil in the item list.
659 It's meaningful only for dialog boxes. */
660 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
662 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
664 /* Create a new pane. */
665 Lisp_Object pane_name
;
666 const char *pane_string
;
670 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
673 if (STRINGP (pane_name
))
675 if (unicode_append_menu
)
676 /* Encode as UTF-8 for now. */
677 pane_name
= ENCODE_UTF_8 (pane_name
);
678 else if (STRING_MULTIBYTE (pane_name
))
679 pane_name
= ENCODE_SYSTEM (pane_name
);
681 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
683 #elif defined (USE_LUCID) && defined (HAVE_XFT)
684 if (STRINGP (pane_name
))
686 pane_name
= ENCODE_UTF_8 (pane_name
);
687 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
689 #elif !defined (HAVE_MULTILINGUAL_MENU)
690 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
692 pane_name
= ENCODE_MENU_STRING (pane_name
);
693 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
697 pane_string
= (NILP (pane_name
)
698 ? "" : SSDATA (pane_name
));
699 /* If there is just one top-level pane, put all its items directly
700 under the top-level menu. */
701 if (menu_items_n_panes
== 1)
704 /* If the pane has a meaningful name,
705 make the pane a top-level menu item
706 with its items as a submenu beneath it. */
707 if (strcmp (pane_string
, ""))
709 wv
= xmalloc_widget_value ();
713 first_wv
->contents
= wv
;
714 wv
->lname
= pane_name
;
715 /* Set value to 1 so update_submenu_strings can handle '@' */
716 wv
->value
= (char *)1;
718 wv
->button_type
= BUTTON_TYPE_NONE
;
726 i
+= MENU_ITEMS_PANE_LENGTH
;
730 /* Create a new item within current pane. */
731 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
734 /* All items should be contained in panes. */
738 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
739 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
740 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
741 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
742 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
743 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
744 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
747 if (STRINGP (item_name
))
749 if (unicode_append_menu
)
750 item_name
= ENCODE_UTF_8 (item_name
);
751 else if (STRING_MULTIBYTE (item_name
))
752 item_name
= ENCODE_SYSTEM (item_name
);
754 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
757 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
759 descrip
= ENCODE_SYSTEM (descrip
);
760 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
763 if (STRINGP (item_name
))
765 item_name
= ENCODE_UTF_8 (item_name
);
766 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
769 if (STRINGP (descrip
))
771 descrip
= ENCODE_UTF_8 (descrip
);
772 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
774 #elif !defined (HAVE_MULTILINGUAL_MENU)
775 if (STRING_MULTIBYTE (item_name
))
777 item_name
= ENCODE_MENU_STRING (item_name
);
778 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
781 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
783 descrip
= ENCODE_MENU_STRING (descrip
);
784 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
788 wv
= xmalloc_widget_value ();
792 save_wv
->contents
= wv
;
794 wv
->lname
= item_name
;
798 /* The EMACS_INT cast avoids a warning. There's no problem
799 as long as pointers have enough bits to hold small integers. */
800 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
801 wv
->enabled
= !NILP (enable
);
804 wv
->button_type
= BUTTON_TYPE_NONE
;
805 else if (EQ (type
, QCradio
))
806 wv
->button_type
= BUTTON_TYPE_RADIO
;
807 else if (EQ (type
, QCtoggle
))
808 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
812 wv
->selected
= !NILP (selected
);
813 if (! STRINGP (help
))
820 i
+= MENU_ITEMS_ITEM_LENGTH
;
824 /* If we have just one "menu item"
825 that was originally a button, return it by itself. */
826 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
828 wv
= first_wv
->contents
;
829 free_widget_value (first_wv
);
836 /* Walk through the widget_value tree starting at FIRST_WV and update
837 the char * pointers from the corresponding lisp values.
838 We do this after building the whole tree, since GC may happen while the
839 tree is constructed, and small strings are relocated. So we must wait
840 until no GC can happen before storing pointers into lisp values. */
842 update_submenu_strings (widget_value
*first_wv
)
846 for (wv
= first_wv
; wv
; wv
= wv
->next
)
848 if (STRINGP (wv
->lname
))
850 wv
->name
= SSDATA (wv
->lname
);
852 /* Ignore the @ that means "separate pane".
853 This is a kludge, but this isn't worth more time. */
854 if (wv
->value
== (char *)1)
856 if (wv
->name
[0] == '@')
862 if (STRINGP (wv
->lkey
))
863 wv
->key
= SSDATA (wv
->lkey
);
866 update_submenu_strings (wv
->contents
);
870 /* Find the menu selection and store it in the keyboard buffer.
871 F is the frame the menu is on.
872 MENU_BAR_ITEMS_USED is the length of VECTOR.
873 VECTOR is an array of menu events for the whole menu. */
876 find_and_call_menu_selection (FRAME_PTR f
, int menu_bar_items_used
, Lisp_Object vector
, void *client_data
)
878 Lisp_Object prefix
, entry
;
879 Lisp_Object
*subprefix_stack
;
880 int submenu_depth
= 0;
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. */)
1063 (Lisp_Object position
, Lisp_Object menu
)
1065 Lisp_Object keymap
, tem
;
1066 int xpos
= 0, ypos
= 0;
1068 const char *error_name
= NULL
;
1069 Lisp_Object selection
= Qnil
;
1071 Lisp_Object x
, y
, window
;
1074 int specpdl_count
= SPECPDL_INDEX ();
1075 struct gcpro gcpro1
;
1077 if (NILP (position
))
1078 /* This is an obsolete call, which wants us to precompute the
1079 keybinding equivalents, but we don't do that any more anyway. */
1084 int get_current_pos_p
= 0;
1085 /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
1087 /* Decode the first argument: find the window and the coordinates. */
1088 if (EQ (position
, Qt
)
1089 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
1090 || EQ (XCAR (position
), Qtool_bar
))))
1092 get_current_pos_p
= 1;
1096 tem
= Fcar (position
);
1099 window
= Fcar (Fcdr (position
));
1101 y
= Fcar (XCDR (tem
));
1106 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1107 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1108 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
1113 /* If a click happens in an external tool bar or a detached
1114 tool bar, x and y is NIL. In that case, use the current
1115 mouse position. This happens for the help button in the
1116 tool bar. Ideally popup-menu should pass NIL to
1117 this function, but it doesn't. */
1118 if (NILP (x
) && NILP (y
))
1119 get_current_pos_p
= 1;
1122 if (get_current_pos_p
)
1124 /* Use the mouse's current position. */
1125 FRAME_PTR new_f
= SELECTED_FRAME ();
1126 #ifdef HAVE_X_WINDOWS
1127 /* Can't use mouse_position_hook for X since it returns
1128 coordinates relative to the window the mouse is in,
1129 we need coordinates relative to the edit widget always. */
1134 mouse_position_for_popup (new_f
, &cur_x
, &cur_y
);
1135 /* cur_x/y may be negative, so use make_number. */
1136 x
= make_number (cur_x
);
1137 y
= make_number (cur_y
);
1140 #else /* not HAVE_X_WINDOWS */
1141 Lisp_Object bar_window
;
1142 enum scroll_bar_part part
;
1144 void (*mouse_position_hook
) (struct frame
**, int,
1146 enum scroll_bar_part
*,
1150 FRAME_TERMINAL (new_f
)->mouse_position_hook
;
1152 if (mouse_position_hook
)
1153 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
1154 &part
, &x
, &y
, &time
);
1155 #endif /* not HAVE_X_WINDOWS */
1158 XSETFRAME (window
, new_f
);
1161 window
= selected_window
;
1170 /* Decode where to put the menu. */
1172 if (FRAMEP (window
))
1174 f
= XFRAME (window
);
1178 else if (WINDOWP (window
))
1180 struct window
*win
= XWINDOW (window
);
1181 CHECK_LIVE_WINDOW (window
);
1182 f
= XFRAME (WINDOW_FRAME (win
));
1184 xpos
= WINDOW_LEFT_EDGE_X (win
);
1185 ypos
= WINDOW_TOP_EDGE_Y (win
);
1188 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1189 but I don't want to make one now. */
1190 CHECK_WINDOW (window
);
1195 /* FIXME: Find a more general check! */
1196 if (!(FRAME_X_P (f
) || FRAME_MSDOS_P (f
)
1197 || FRAME_W32_P (f
) || FRAME_NS_P (f
)))
1198 error ("Can not put GUI menu on this terminal");
1200 XSETFRAME (Vmenu_updating_frame
, f
);
1202 #endif /* HAVE_MENUS */
1204 /* Now parse the lisp menus. */
1205 record_unwind_protect (unuse_menu_items
, Qnil
);
1210 /* Decode the menu items from what was specified. */
1212 keymap
= get_keymap (menu
, 0, 0);
1215 /* We were given a keymap. Extract menu info from the keymap. */
1218 /* Extract the detailed info to make one pane. */
1219 keymap_panes (&menu
, 1);
1221 /* Search for a string appearing directly as an element of the keymap.
1222 That string is the title of the menu. */
1223 prompt
= Fkeymap_prompt (keymap
);
1226 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1228 title
= build_string ("Select");
1231 /* Make that be the pane title of the first pane. */
1232 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
1233 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
1237 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
1239 /* We were given a list of keymaps. */
1240 int nmaps
= XFASTINT (Flength (menu
));
1242 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
1247 /* The first keymap that has a prompt string
1248 supplies the menu title. */
1249 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
1253 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
1255 prompt
= Fkeymap_prompt (keymap
);
1256 if (NILP (title
) && !NILP (prompt
))
1260 /* Extract the detailed info to make one pane. */
1261 keymap_panes (maps
, nmaps
);
1263 /* Make the title be the pane title of the first pane. */
1264 if (!NILP (title
) && menu_items_n_panes
>= 0)
1265 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
1271 /* We were given an old-fashioned menu. */
1272 title
= Fcar (menu
);
1273 CHECK_STRING (title
);
1275 list_of_panes (Fcdr (menu
));
1280 unbind_to (specpdl_count
, Qnil
);
1283 #ifdef HAVE_WINDOW_SYSTEM
1284 /* Hide a previous tip, if any. */
1288 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1289 /* If resources from a previous popup menu still exist, does nothing
1290 until the `menu_free_timer' has freed them (see w32fns.c). This
1291 can occur if you press ESC or click outside a menu without selecting
1294 if (current_popup_menu
)
1296 discard_menu_items ();
1297 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1303 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1304 record_unwind_protect (cleanup_popup_menu
, Qnil
);
1307 /* Display them in a menu. */
1310 /* FIXME: Use a terminal hook! */
1311 #if defined HAVE_NTGUI
1312 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
1313 keymaps
, title
, &error_name
);
1314 #elif defined HAVE_NS
1315 selection
= ns_menu_show (f
, xpos
, ypos
, for_click
,
1316 keymaps
, title
, &error_name
);
1317 #else /* MSDOS and X11 */
1318 /* Assume last_event_timestamp is the timestamp of the button event.
1319 Is this assumption ever violated? We can't use the timestamp
1320 stored within POSITION because there the top bits from the actual
1321 timestamp may be truncated away (Bug#4930). */
1322 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
1323 keymaps
, title
, &error_name
,
1324 last_event_timestamp
);
1330 unbind_to (specpdl_count
, Qnil
);
1332 discard_menu_items ();
1335 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1336 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1339 #endif /* HAVE_MENUS */
1343 if (error_name
) error ("%s", error_name
);
1350 staticpro (&menu_items
);
1352 menu_items_inuse
= Qnil
;
1354 defsubr (&Sx_popup_menu
);