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 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
252 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
253 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
254 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
255 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
256 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
257 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
258 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
261 /* Args passed between single_keymap_panes and single_menu_item. */
264 Lisp_Object pending_maps
;
269 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
272 /* This is a recursive subroutine of keymap_panes.
273 It handles one keymap, KEYMAP.
274 The other arguments are passed along
275 or point to local variables of the previous function.
277 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
280 single_keymap_panes (Lisp_Object keymap
, Lisp_Object pane_name
,
281 Lisp_Object prefix
, int maxdepth
)
286 skp
.pending_maps
= Qnil
;
287 skp
.maxdepth
= maxdepth
;
293 push_menu_pane (pane_name
, prefix
);
296 /* Remember index for first item in this pane so we can go back and
297 add a prefix when (if) we see the first button. After that, notbuttons
298 is set to 0, to mark that we have seen a button and all non button
299 items need a prefix. */
300 skp
.notbuttons
= menu_items_used
;
303 GCPRO1 (skp
.pending_maps
);
304 map_keymap_canonical (keymap
, single_menu_item
, Qnil
, &skp
);
307 /* Process now any submenus which want to be panes at this level. */
308 while (CONSP (skp
.pending_maps
))
310 Lisp_Object elt
, eltcdr
, string
;
311 elt
= XCAR (skp
.pending_maps
);
313 string
= XCAR (eltcdr
);
314 /* We no longer discard the @ from the beginning of the string here.
315 Instead, we do this in *menu_show. */
316 single_keymap_panes (Fcar (elt
), string
, XCDR (eltcdr
), maxdepth
- 1);
317 skp
.pending_maps
= XCDR (skp
.pending_maps
);
321 /* This is a subroutine of single_keymap_panes that handles one
323 KEY is a key in a keymap and ITEM is its binding.
324 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
326 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
329 single_menu_item (key
, item
, dummy
, skp_v
)
330 Lisp_Object key
, item
, dummy
;
333 Lisp_Object map
, item_string
, enabled
;
334 struct gcpro gcpro1
, gcpro2
;
336 struct skp
*skp
= skp_v
;
338 /* Parse the menu item and leave the result in item_properties. */
340 res
= parse_menu_item (item
, 0);
343 return; /* Not a menu item. */
345 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
347 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
348 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
350 if (!NILP (map
) && SREF (item_string
, 0) == '@')
353 /* An enabled separate pane. Remember this to handle it later. */
354 skp
->pending_maps
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
359 #if defined(HAVE_X_WINDOWS) || defined(MSDOS)
361 /* Simulate radio buttons and toggle boxes by putting a prefix in
364 Lisp_Object prefix
= Qnil
;
365 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
369 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
372 /* The first button. Line up previous items in this menu. */
374 int index
= skp
->notbuttons
; /* Index for first item this menu. */
377 while (index
< menu_items_used
)
380 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
384 submenu
++; /* Skip sub menu. */
386 else if (EQ (tem
, Qlambda
))
389 submenu
--; /* End sub menu. */
391 else if (EQ (tem
, Qt
))
392 index
+= 3; /* Skip new pane marker. */
393 else if (EQ (tem
, Qquote
))
394 index
++; /* Skip a left, right divider. */
397 if (!submenu
&& SREF (tem
, 0) != '\0'
398 && SREF (tem
, 0) != '-')
399 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
400 = concat2 (build_string (" "), tem
);
401 index
+= MENU_ITEMS_ITEM_LENGTH
;
407 /* Calculate prefix, if any, for this item. */
408 if (EQ (type
, QCtoggle
))
409 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
410 else if (EQ (type
, QCradio
))
411 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
413 /* Not a button. If we have earlier buttons, then we need a prefix. */
414 else if (!skp
->notbuttons
&& SREF (item_string
, 0) != '\0'
415 && SREF (item_string
, 0) != '-')
416 prefix
= build_string (" ");
419 item_string
= concat2 (prefix
, item_string
);
421 #endif /* not HAVE_BOXES */
423 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
425 /* Indicate visually that this is a submenu. */
426 item_string
= concat2 (item_string
, build_string (" >"));
429 #endif /* HAVE_X_WINDOWS || MSDOS */
431 push_menu_item (item_string
, enabled
, key
,
432 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
433 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
434 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
435 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
436 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
438 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
439 /* Display a submenu using the toolkit. */
440 if (! (NILP (map
) || NILP (enabled
)))
442 push_submenu_start ();
443 single_keymap_panes (map
, Qnil
, key
, skp
->maxdepth
- 1);
449 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
450 and generate menu panes for them in menu_items. */
453 keymap_panes (keymaps
, nmaps
)
454 Lisp_Object
*keymaps
;
461 /* Loop over the given keymaps, making a pane for each map.
462 But don't make a pane that is empty--ignore that map instead.
463 P is the number of panes we have made so far. */
464 for (mapno
= 0; mapno
< nmaps
; mapno
++)
465 single_keymap_panes (keymaps
[mapno
],
466 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, 10);
468 finish_menu_items ();
472 /* Push the items in a single pane defined by the alist PANE. */
477 Lisp_Object tail
, item
, item1
;
479 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
483 push_menu_item (ENCODE_MENU_STRING (item
), Qnil
, Qnil
, Qt
,
484 Qnil
, Qnil
, Qnil
, Qnil
);
485 else if (CONSP (item
))
488 CHECK_STRING (item1
);
489 push_menu_item (ENCODE_MENU_STRING (item1
), Qt
, XCDR (item
),
490 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
493 push_left_right_boundary ();
498 /* Push all the panes and items of a menu described by the
499 alist-of-alists MENU.
500 This handles old-fashioned calls to x-popup-menu. */
509 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
511 Lisp_Object elt
, pane_name
, pane_data
;
513 pane_name
= Fcar (elt
);
514 CHECK_STRING (pane_name
);
515 push_menu_pane (ENCODE_MENU_STRING (pane_name
), Qnil
);
516 pane_data
= Fcdr (elt
);
517 CHECK_CONS (pane_data
);
518 list_of_items (pane_data
);
521 finish_menu_items ();
524 /* Set up data in menu_items for a menu bar item
525 whose event type is ITEM_KEY (with string ITEM_NAME)
526 and whose contents come from the list of keymaps MAPS. */
528 parse_single_submenu (item_key
, item_name
, maps
)
529 Lisp_Object item_key
, item_name
, maps
;
535 int top_level_items
= 0;
537 length
= Flength (maps
);
540 /* Convert the list MAPS into a vector MAPVEC. */
541 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
542 for (i
= 0; i
< len
; i
++)
544 mapvec
[i
] = Fcar (maps
);
548 /* Loop over the given keymaps, making a pane for each map.
549 But don't make a pane that is empty--ignore that map instead. */
550 for (i
= 0; i
< len
; i
++)
552 if (!KEYMAPP (mapvec
[i
]))
554 /* Here we have a command at top level in the menu bar
555 as opposed to a submenu. */
557 push_menu_pane (Qnil
, Qnil
);
558 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
559 Qnil
, Qnil
, Qnil
, Qnil
);
564 prompt
= Fkeymap_prompt (mapvec
[i
]);
565 single_keymap_panes (mapvec
[i
],
566 !NILP (prompt
) ? prompt
: item_name
,
571 return top_level_items
;
575 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
577 /* Allocate a widget_value, blocking input. */
580 xmalloc_widget_value ()
585 value
= malloc_widget_value ();
591 /* This recursively calls free_widget_value on the tree of widgets.
592 It must free all data that was malloc'ed for these widget_values.
593 In Emacs, many slots are pointers into the data of Lisp_Strings, and
594 must be left alone. */
597 free_menubar_widget_value_tree (wv
)
602 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
604 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
606 free_menubar_widget_value_tree (wv
->contents
);
607 wv
->contents
= (widget_value
*) 0xDEADBEEF;
611 free_menubar_widget_value_tree (wv
->next
);
612 wv
->next
= (widget_value
*) 0xDEADBEEF;
615 free_widget_value (wv
);
619 /* Create a tree of widget_value objects
620 representing the panes and items
621 in menu_items starting at index START, up to index END. */
624 digest_single_submenu (start
, end
, top_level_items
)
625 int start
, end
, top_level_items
;
627 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
629 int submenu_depth
= 0;
630 widget_value
**submenu_stack
;
634 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
635 wv
= xmalloc_widget_value ();
639 wv
->button_type
= BUTTON_TYPE_NONE
;
645 /* Loop over all panes and items made by the preceding call
646 to parse_single_submenu and construct a tree of widget_value objects.
647 Ignore the panes and items used by previous calls to
648 digest_single_submenu, even though those are also in menu_items. */
652 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
654 submenu_stack
[submenu_depth
++] = save_wv
;
659 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
662 save_wv
= submenu_stack
[--submenu_depth
];
665 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
666 && submenu_depth
!= 0)
667 i
+= MENU_ITEMS_PANE_LENGTH
;
668 /* Ignore a nil in the item list.
669 It's meaningful only for dialog boxes. */
670 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
672 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
674 /* Create a new pane. */
675 Lisp_Object pane_name
, prefix
;
680 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
681 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
684 if (STRINGP (pane_name
))
686 if (unicode_append_menu
)
687 /* Encode as UTF-8 for now. */
688 pane_name
= ENCODE_UTF_8 (pane_name
);
689 else if (STRING_MULTIBYTE (pane_name
))
690 pane_name
= ENCODE_SYSTEM (pane_name
);
692 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
694 #elif !defined (HAVE_MULTILINGUAL_MENU)
695 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
697 pane_name
= ENCODE_MENU_STRING (pane_name
);
698 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
702 pane_string
= (NILP (pane_name
)
703 ? "" : (char *) SDATA (pane_name
));
704 /* If there is just one top-level pane, put all its items directly
705 under the top-level menu. */
706 if (menu_items_n_panes
== 1)
709 /* If the pane has a meaningful name,
710 make the pane a top-level menu item
711 with its items as a submenu beneath it. */
712 if (strcmp (pane_string
, ""))
714 wv
= xmalloc_widget_value ();
718 first_wv
->contents
= wv
;
719 wv
->lname
= pane_name
;
720 /* Set value to 1 so update_submenu_strings can handle '@' */
721 wv
->value
= (char *)1;
723 wv
->button_type
= BUTTON_TYPE_NONE
;
731 i
+= MENU_ITEMS_PANE_LENGTH
;
735 /* Create a new item within current pane. */
736 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
739 /* All items should be contained in panes. */
743 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
744 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
745 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
746 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
747 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
748 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
749 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
752 if (STRINGP (item_name
))
754 if (unicode_append_menu
)
755 item_name
= ENCODE_UTF_8 (item_name
);
756 else if (STRING_MULTIBYTE (item_name
))
757 item_name
= ENCODE_SYSTEM (item_name
);
759 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
762 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
764 descrip
= ENCODE_SYSTEM (descrip
);
765 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
767 #elif !defined (HAVE_MULTILINGUAL_MENU)
768 if (STRING_MULTIBYTE (item_name
))
770 item_name
= ENCODE_MENU_STRING (item_name
);
771 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
774 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
776 descrip
= ENCODE_MENU_STRING (descrip
);
777 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
781 wv
= xmalloc_widget_value ();
785 save_wv
->contents
= wv
;
787 wv
->lname
= item_name
;
791 /* The EMACS_INT cast avoids a warning. There's no problem
792 as long as pointers have enough bits to hold small integers. */
793 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
794 wv
->enabled
= !NILP (enable
);
797 wv
->button_type
= BUTTON_TYPE_NONE
;
798 else if (EQ (type
, QCradio
))
799 wv
->button_type
= BUTTON_TYPE_RADIO
;
800 else if (EQ (type
, QCtoggle
))
801 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
805 wv
->selected
= !NILP (selected
);
806 if (! STRINGP (help
))
813 i
+= MENU_ITEMS_ITEM_LENGTH
;
817 /* If we have just one "menu item"
818 that was originally a button, return it by itself. */
819 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
821 wv
= first_wv
->contents
;
822 free_widget_value (first_wv
);
829 /* Walk through the widget_value tree starting at FIRST_WV and update
830 the char * pointers from the corresponding lisp values.
831 We do this after building the whole tree, since GC may happen while the
832 tree is constructed, and small strings are relocated. So we must wait
833 until no GC can happen before storing pointers into lisp values. */
835 update_submenu_strings (first_wv
)
836 widget_value
*first_wv
;
840 for (wv
= first_wv
; wv
; wv
= wv
->next
)
842 if (STRINGP (wv
->lname
))
844 wv
->name
= (char *) SDATA (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
= (char *) SDATA (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 (f
, menu_bar_items_used
, vector
, client_data
)
872 int menu_bar_items_used
;
876 Lisp_Object prefix
, entry
;
877 Lisp_Object
*subprefix_stack
;
878 int submenu_depth
= 0;
882 subprefix_stack
= (Lisp_Object
*) alloca (menu_bar_items_used
* sizeof (Lisp_Object
));
886 while (i
< menu_bar_items_used
)
888 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
890 subprefix_stack
[submenu_depth
++] = prefix
;
894 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
896 prefix
= subprefix_stack
[--submenu_depth
];
899 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
901 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
902 i
+= MENU_ITEMS_PANE_LENGTH
;
906 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
907 /* The EMACS_INT cast avoids a warning. There's no problem
908 as long as pointers have enough bits to hold small integers. */
909 if ((int) (EMACS_INT
) client_data
== i
)
912 struct input_event buf
;
916 XSETFRAME (frame
, f
);
917 buf
.kind
= MENU_BAR_EVENT
;
918 buf
.frame_or_window
= frame
;
920 kbd_buffer_store_event (&buf
);
922 for (j
= 0; j
< submenu_depth
; j
++)
923 if (!NILP (subprefix_stack
[j
]))
925 buf
.kind
= MENU_BAR_EVENT
;
926 buf
.frame_or_window
= frame
;
927 buf
.arg
= subprefix_stack
[j
];
928 kbd_buffer_store_event (&buf
);
933 buf
.kind
= MENU_BAR_EVENT
;
934 buf
.frame_or_window
= frame
;
936 kbd_buffer_store_event (&buf
);
939 buf
.kind
= MENU_BAR_EVENT
;
940 buf
.frame_or_window
= frame
;
942 kbd_buffer_store_event (&buf
);
946 i
+= MENU_ITEMS_ITEM_LENGTH
;
951 #endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
954 /* As above, but return the menu selection instead of storing in kb buffer.
955 If keymaps==1, return full prefixes to selection. */
957 find_and_return_menu_selection (FRAME_PTR f
, int keymaps
, void *client_data
)
959 Lisp_Object prefix
, entry
;
961 Lisp_Object
*subprefix_stack
;
962 int submenu_depth
= 0;
964 prefix
= entry
= Qnil
;
967 (Lisp_Object
*)alloca(menu_items_used
* sizeof (Lisp_Object
));
969 while (i
< menu_items_used
)
971 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
973 subprefix_stack
[submenu_depth
++] = prefix
;
977 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
979 prefix
= subprefix_stack
[--submenu_depth
];
982 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
985 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
986 i
+= MENU_ITEMS_PANE_LENGTH
;
988 /* Ignore a nil in the item list.
989 It's meaningful only for dialog boxes. */
990 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
995 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
996 if ((EMACS_INT
)client_data
== (EMACS_INT
)(&XVECTOR (menu_items
)->contents
[i
]))
1002 entry
= Fcons (entry
, Qnil
);
1004 entry
= Fcons (prefix
, entry
);
1005 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1006 if (!NILP (subprefix_stack
[j
]))
1007 entry
= Fcons (subprefix_stack
[j
], entry
);
1011 i
+= MENU_ITEMS_ITEM_LENGTH
;
1016 #endif /* HAVE_NS */
1018 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
1019 doc
: /* Pop up a deck-of-cards menu and return user's selection.
1020 POSITION is a position specification. This is either a mouse button event
1021 or a list ((XOFFSET YOFFSET) WINDOW)
1022 where XOFFSET and YOFFSET are positions in pixels from the top left
1023 corner of WINDOW. (WINDOW may be a window or a frame object.)
1024 This controls the position of the top left of the menu as a whole.
1025 If POSITION is t, it means to use the current mouse position.
1027 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
1028 The menu items come from key bindings that have a menu string as well as
1029 a definition; actually, the "definition" in such a key binding looks like
1030 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
1031 the keymap as a top-level element.
1033 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
1034 Otherwise, REAL-DEFINITION should be a valid key binding definition.
1036 You can also use a list of keymaps as MENU.
1037 Then each keymap makes a separate pane.
1039 When MENU is a keymap or a list of keymaps, the return value is the
1040 list of events corresponding to the user's choice. Note that
1041 `x-popup-menu' does not actually execute the command bound to that
1044 Alternatively, you can specify a menu of multiple panes
1045 with a list of the form (TITLE PANE1 PANE2...),
1046 where each pane is a list of form (TITLE ITEM1 ITEM2...).
1047 Each ITEM is normally a cons cell (STRING . VALUE);
1048 but a string can appear as an item--that makes a nonselectable line
1050 With this form of menu, the return value is VALUE from the chosen item.
1052 If POSITION is nil, don't display the menu at all, just precalculate the
1053 cached information about equivalent key sequences.
1055 If the user gets rid of the menu without making a valid choice, for
1056 instance by clicking the mouse away from a valid choice or by typing
1057 keyboard input, then this normally results in a quit and
1058 `x-popup-menu' does not return. But if POSITION is a mouse button
1059 event (indicating that the user invoked the menu with the mouse) then
1060 no quit occurs and `x-popup-menu' returns nil. */)
1062 Lisp_Object position
, menu
;
1064 Lisp_Object keymap
, tem
;
1065 int xpos
= 0, ypos
= 0;
1067 char *error_name
= NULL
;
1068 Lisp_Object selection
= Qnil
;
1070 Lisp_Object x
, y
, window
;
1073 int specpdl_count
= SPECPDL_INDEX ();
1074 Lisp_Object timestamp
= Qnil
;
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
= Fcdr (Fcdr (tem
));
1109 x
= Fcar (Fcar (tem
));
1110 y
= Fcdr (Fcar (tem
));
1111 timestamp
= Fcar (Fcdr (tem
));
1114 /* If a click happens in an external tool bar or a detached
1115 tool bar, x and y is NIL. In that case, use the current
1116 mouse position. This happens for the help button in the
1117 tool bar. Ideally popup-menu should pass NIL to
1118 this function, but it doesn't. */
1119 if (NILP (x
) && NILP (y
))
1120 get_current_pos_p
= 1;
1123 if (get_current_pos_p
)
1125 /* Use the mouse's current position. */
1126 FRAME_PTR new_f
= SELECTED_FRAME ();
1127 #ifdef HAVE_X_WINDOWS
1128 /* Can't use mouse_position_hook for X since it returns
1129 coordinates relative to the window the mouse is in,
1130 we need coordinates relative to the edit widget always. */
1135 mouse_position_for_popup (new_f
, &cur_x
, &cur_y
);
1136 /* cur_x/y may be negative, so use make_number. */
1137 x
= make_number (cur_x
);
1138 y
= make_number (cur_y
);
1141 #else /* not HAVE_X_WINDOWS */
1142 Lisp_Object bar_window
;
1143 enum scroll_bar_part part
;
1145 void (*mouse_position_hook
) P_ ((struct frame
**, int,
1147 enum scroll_bar_part
*,
1151 FRAME_TERMINAL (new_f
)->mouse_position_hook
;
1153 if (mouse_position_hook
)
1154 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
1155 &part
, &x
, &y
, &time
);
1156 #endif /* not HAVE_X_WINDOWS */
1159 XSETFRAME (window
, new_f
);
1162 window
= selected_window
;
1171 /* Decode where to put the menu. */
1173 if (FRAMEP (window
))
1175 f
= XFRAME (window
);
1179 else if (WINDOWP (window
))
1181 struct window
*win
= XWINDOW (window
);
1182 CHECK_LIVE_WINDOW (window
);
1183 f
= XFRAME (WINDOW_FRAME (win
));
1185 #ifdef HAVE_NS /* FIXME: Is this necessary?? --Stef */
1186 xpos
= FRAME_COLUMN_WIDTH (f
) * WINDOW_LEFT_EDGE_COL (win
);
1187 ypos
= FRAME_LINE_HEIGHT (f
) * WINDOW_TOP_EDGE_LINE (win
);
1189 xpos
= WINDOW_LEFT_EDGE_X (win
);
1190 ypos
= WINDOW_TOP_EDGE_Y (win
);
1194 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1195 but I don't want to make one now. */
1196 CHECK_WINDOW (window
);
1201 /* FIXME: Find a more general check! */
1202 if (!(FRAME_X_P (f
) || FRAME_MSDOS_P (f
)
1203 || FRAME_W32_P (f
) || FRAME_NS_P (f
)))
1204 error ("Can not put GUI menu on this terminal");
1206 XSETFRAME (Vmenu_updating_frame
, f
);
1208 #endif /* HAVE_MENUS */
1210 /* Now parse the lisp menus. */
1211 record_unwind_protect (unuse_menu_items
, Qnil
);
1216 /* Decode the menu items from what was specified. */
1218 keymap
= get_keymap (menu
, 0, 0);
1221 /* We were given a keymap. Extract menu info from the keymap. */
1224 /* Extract the detailed info to make one pane. */
1225 keymap_panes (&menu
, 1);
1227 /* Search for a string appearing directly as an element of the keymap.
1228 That string is the title of the menu. */
1229 prompt
= Fkeymap_prompt (keymap
);
1232 #ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
1234 title
= build_string ("Select");
1237 /* Make that be the pane title of the first pane. */
1238 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
1239 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
1243 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
1245 /* We were given a list of keymaps. */
1246 int nmaps
= XFASTINT (Flength (menu
));
1248 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
1253 /* The first keymap that has a prompt string
1254 supplies the menu title. */
1255 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= XCDR (tem
))
1259 maps
[i
++] = keymap
= get_keymap (XCAR (tem
), 1, 0);
1261 prompt
= Fkeymap_prompt (keymap
);
1262 if (NILP (title
) && !NILP (prompt
))
1266 /* Extract the detailed info to make one pane. */
1267 keymap_panes (maps
, nmaps
);
1269 /* Make the title be the pane title of the first pane. */
1270 if (!NILP (title
) && menu_items_n_panes
>= 0)
1271 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
1277 /* We were given an old-fashioned menu. */
1278 title
= Fcar (menu
);
1279 CHECK_STRING (title
);
1281 list_of_panes (Fcdr (menu
));
1286 unbind_to (specpdl_count
, Qnil
);
1289 #ifdef HAVE_WINDOW_SYSTEM
1290 /* Hide a previous tip, if any. */
1294 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1295 /* If resources from a previous popup menu still exist, does nothing
1296 until the `menu_free_timer' has freed them (see w32fns.c). This
1297 can occur if you press ESC or click outside a menu without selecting
1300 if (current_popup_menu
)
1302 discard_menu_items ();
1303 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1309 #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
1310 record_unwind_protect (cleanup_popup_menu
, Qnil
);
1313 /* Display them in a menu. */
1316 /* FIXME: Use a terminal hook! */
1317 #if defined HAVE_NTGUI
1318 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
1319 keymaps
, title
, &error_name
);
1320 #elif defined HAVE_NS
1321 selection
= ns_menu_show (f
, xpos
, ypos
, for_click
,
1322 keymaps
, title
, &error_name
);
1323 #else /* MSDOS and X11 */
1324 selection
= xmenu_show (f
, xpos
, ypos
, for_click
,
1325 keymaps
, title
, &error_name
,
1326 INTEGERP (timestamp
) ? XUINT (timestamp
) : 0);
1332 unbind_to (specpdl_count
, Qnil
);
1334 discard_menu_items ();
1337 #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
1338 FRAME_X_DISPLAY_INFO (f
)->grabbed
= 0;
1341 #endif /* HAVE_MENUS */
1345 if (error_name
) error (error_name
);
1352 staticpro (&menu_items
);
1354 menu_items_inuse
= Qnil
;
1356 defsubr (&Sx_popup_menu
);
1359 /* arch-tag: 78bbc7cf-8025-4156-aa8a-6c7fd99bf51d
1360 (do not change this comment) */