X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3a408e5854572a5d8ea068c1fd1a981e4f8a37a2..41d579ce4a2a86428f200788df4b15b936aa5076:/src/menu.c
diff --git a/src/menu.c b/src/menu.c
index 7554f2a99c..851f1ac804 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1,6 +1,7 @@
/* Platform-independent code for terminal communications.
- Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+
+Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2011
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,11 +20,13 @@ along with GNU Emacs. If not, see . */
#include
#include
+#include
#include "lisp.h"
#include "keyboard.h"
#include "keymap.h"
#include "frame.h"
+#include "window.h"
#include "termhooks.h"
#include "blockinput.h"
#include "dispextern.h"
@@ -36,6 +39,10 @@ along with GNU Emacs. If not, see . */
#include "xterm.h"
#endif
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#ifdef USE_GTK
#include "gtkutil.h"
#endif
@@ -44,17 +51,17 @@ along with GNU Emacs. If not, see . */
#include "w32term.h"
extern AppendMenuW_Proc unicode_append_menu;
+extern HMENU current_popup_menu;
#endif /* HAVE_NTGUI */
+#include "menu.h"
/* Define HAVE_BOXES if menus can handle radio and toggle buttons. */
#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
#define HAVE_BOXES 1
#endif
-extern Lisp_Object QCtoggle, QCradio;
-
Lisp_Object menu_items;
/* If non-nil, means that the global vars defined here are already in use.
@@ -75,7 +82,7 @@ int menu_items_n_panes;
static int menu_items_submenu_depth;
void
-init_menu_items ()
+init_menu_items (void)
{
if (!NILP (menu_items_inuse))
error ("Trying to use a menu from within a menu-entry");
@@ -95,13 +102,12 @@ init_menu_items ()
/* Call at the end of generating the data in menu_items. */
void
-finish_menu_items ()
+finish_menu_items (void)
{
}
Lisp_Object
-unuse_menu_items (dummy)
- Lisp_Object dummy;
+unuse_menu_items (Lisp_Object dummy)
{
return menu_items_inuse = Qnil;
}
@@ -110,7 +116,7 @@ unuse_menu_items (dummy)
in menu_items. */
void
-discard_menu_items ()
+discard_menu_items (void)
{
/* Free the structure if it is especially large.
Otherwise, hold on to it, to save time. */
@@ -122,12 +128,20 @@ discard_menu_items ()
xassert (NILP (menu_items_inuse));
}
+#ifdef HAVE_NS
+static Lisp_Object
+cleanup_popup_menu (Lisp_Object arg)
+{
+ discard_menu_items ();
+ return Qnil;
+}
+#endif
+
/* This undoes save_menu_items, and it is called by the specpdl unwind
mechanism. */
static Lisp_Object
-restore_menu_items (saved)
- Lisp_Object saved;
+restore_menu_items (Lisp_Object saved)
{
menu_items = XCAR (saved);
menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
@@ -145,7 +159,7 @@ restore_menu_items (saved)
It will be restored when the specpdl is unwound. */
void
-save_menu_items ()
+save_menu_items (void)
{
Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil,
make_number (menu_items_used),
@@ -160,7 +174,7 @@ save_menu_items ()
/* Make the menu_items vector twice as large. */
static void
-grow_menu_items ()
+grow_menu_items (void)
{
menu_items_allocated *= 2;
menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
@@ -169,7 +183,7 @@ grow_menu_items ()
/* Begin a submenu. */
static void
-push_submenu_start ()
+push_submenu_start (void)
{
if (menu_items_used + 1 > menu_items_allocated)
grow_menu_items ();
@@ -181,7 +195,7 @@ push_submenu_start ()
/* End a submenu. */
static void
-push_submenu_end ()
+push_submenu_end (void)
{
if (menu_items_used + 1 > menu_items_allocated)
grow_menu_items ();
@@ -193,7 +207,7 @@ push_submenu_end ()
/* Indicate boundary between left and right. */
static void
-push_left_right_boundary ()
+push_left_right_boundary (void)
{
if (menu_items_used + 1 > menu_items_allocated)
grow_menu_items ();
@@ -204,9 +218,8 @@ push_left_right_boundary ()
/* Start a new menu pane in menu_items.
NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
-void
-push_menu_pane (name, prefix_vec)
- Lisp_Object name, prefix_vec;
+static void
+push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec)
{
if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
grow_menu_items ();
@@ -226,57 +239,51 @@ push_menu_pane (name, prefix_vec)
for this item (or nil if none). TYPE is the type of this menu
item, one of nil, `toggle' or `radio'. */
-void
-push_menu_item (name, enable, key, def, equiv, type, selected, help)
- Lisp_Object name, enable, key, def, equiv, type, selected, help;
+static void
+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)
{
if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
grow_menu_items ();
- XVECTOR (menu_items)->contents[menu_items_used++] = name;
- XVECTOR (menu_items)->contents[menu_items_used++] = enable;
- XVECTOR (menu_items)->contents[menu_items_used++] = key;
- XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
- XVECTOR (menu_items)->contents[menu_items_used++] = def;
- XVECTOR (menu_items)->contents[menu_items_used++] = type;
- XVECTOR (menu_items)->contents[menu_items_used++] = selected;
- XVECTOR (menu_items)->contents[menu_items_used++] = help;
+ ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_NAME, name);
+ ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_ENABLE, enable);
+ ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_VALUE, key);
+ ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_EQUIV_KEY, equiv);
+ ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_DEFINITION, def);
+ ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_TYPE, type);
+ ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_SELECTED, selected);
+ ASET (menu_items, menu_items_used + MENU_ITEMS_ITEM_HELP, help);
+
+ menu_items_used += MENU_ITEMS_ITEM_LENGTH;
}
/* Args passed between single_keymap_panes and single_menu_item. */
struct skp
{
Lisp_Object pending_maps;
- int maxdepth, notreal;
+ int maxdepth;
int notbuttons;
};
-static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
- void *));
+static void single_menu_item (Lisp_Object, Lisp_Object, Lisp_Object,
+ void *);
/* This is a recursive subroutine of keymap_panes.
It handles one keymap, KEYMAP.
The other arguments are passed along
or point to local variables of the previous function.
- If NOTREAL is nonzero, only check for equivalent key bindings, don't
- evaluate expressions in menu items and don't make any menu.
If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
-void
-single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
- Lisp_Object keymap;
- Lisp_Object pane_name;
- Lisp_Object prefix;
- int notreal;
- int maxdepth;
+static void
+single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
+ Lisp_Object prefix, int maxdepth)
{
struct skp skp;
struct gcpro gcpro1;
skp.pending_maps = Qnil;
skp.maxdepth = maxdepth;
- skp.notreal = notreal;
skp.notbuttons = 0;
if (maxdepth <= 0)
@@ -305,8 +312,7 @@ single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
string = XCAR (eltcdr);
/* We no longer discard the @ from the beginning of the string here.
Instead, we do this in *menu_show. */
- single_keymap_panes (Fcar (elt), string,
- XCDR (eltcdr), notreal, maxdepth - 1);
+ single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
skp.pending_maps = XCDR (skp.pending_maps);
}
}
@@ -316,14 +322,10 @@ single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
KEY is a key in a keymap and ITEM is its binding.
SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
separate panes.
- If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
- evaluate expressions in menu items and don't make any menu.
If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
static void
-single_menu_item (key, item, dummy, skp_v)
- Lisp_Object key, item, dummy;
- void *skp_v;
+single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
{
Lisp_Object map, item_string, enabled;
struct gcpro gcpro1, gcpro2;
@@ -332,22 +334,13 @@ single_menu_item (key, item, dummy, skp_v)
/* Parse the menu item and leave the result in item_properties. */
GCPRO2 (key, item);
- res = parse_menu_item (item, skp->notreal, 0);
+ res = parse_menu_item (item, 0);
UNGCPRO;
if (!res)
return; /* Not a menu item. */
map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
- if (skp->notreal)
- {
- /* We don't want to make a menu, just traverse the keymaps to
- precompute equivalent key bindings. */
- if (!NILP (map))
- single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
- return;
- }
-
enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
@@ -360,7 +353,7 @@ single_menu_item (key, item, dummy, skp_v)
return;
}
-#ifdef HAVE_X_WINDOWS
+#if defined(HAVE_X_WINDOWS) || defined(MSDOS)
#ifndef HAVE_BOXES
/* Simulate radio buttons and toggle boxes by putting a prefix in
front of them. */
@@ -430,7 +423,7 @@ single_menu_item (key, item, dummy, skp_v)
item_string = concat2 (item_string, build_string (" >"));
#endif
-#endif /* HAVE_X_WINDOWS */
+#endif /* HAVE_X_WINDOWS || MSDOS */
push_menu_item (item_string, enabled, key,
XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
@@ -439,27 +432,22 @@ single_menu_item (key, item, dummy, skp_v)
XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
-#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
/* Display a submenu using the toolkit. */
if (! (NILP (map) || NILP (enabled)))
{
push_submenu_start ();
- single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
+ single_keymap_panes (map, Qnil, key, skp->maxdepth - 1);
push_submenu_end ();
}
#endif
}
/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
- and generate menu panes for them in menu_items.
- If NOTREAL is nonzero,
- don't bother really computing whether an item is enabled. */
+ and generate menu panes for them in menu_items. */
-void
-keymap_panes (keymaps, nmaps, notreal)
- Lisp_Object *keymaps;
- int nmaps;
- int notreal;
+static void
+keymap_panes (Lisp_Object *keymaps, int nmaps)
{
int mapno;
@@ -470,7 +458,7 @@ keymap_panes (keymaps, nmaps, notreal)
P is the number of panes we have made so far. */
for (mapno = 0; mapno < nmaps; mapno++)
single_keymap_panes (keymaps[mapno],
- Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
+ Fkeymap_prompt (keymaps[mapno]), Qnil, 10);
finish_menu_items ();
}
@@ -478,8 +466,7 @@ keymap_panes (keymaps, nmaps, notreal)
/* Push the items in a single pane defined by the alist PANE. */
static void
-list_of_items (pane)
- Lisp_Object pane;
+list_of_items (Lisp_Object pane)
{
Lisp_Object tail, item, item1;
@@ -506,8 +493,7 @@ list_of_items (pane)
alist-of-alists MENU.
This handles old-fashioned calls to x-popup-menu. */
void
-list_of_panes (menu)
- Lisp_Object menu;
+list_of_panes (Lisp_Object menu)
{
Lisp_Object tail;
@@ -532,8 +518,7 @@ list_of_panes (menu)
whose event type is ITEM_KEY (with string ITEM_NAME)
and whose contents come from the list of keymaps MAPS. */
int
-parse_single_submenu (item_key, item_name, maps)
- Lisp_Object item_key, item_name, maps;
+parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps)
{
Lisp_Object length;
int len;
@@ -571,7 +556,7 @@ parse_single_submenu (item_key, item_name, maps)
prompt = Fkeymap_prompt (mapvec[i]);
single_keymap_panes (mapvec[i],
!NILP (prompt) ? prompt : item_name,
- item_key, 0, 10);
+ item_key, 10);
}
}
@@ -579,12 +564,12 @@ parse_single_submenu (item_key, item_name, maps)
}
-#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
/* Allocate a widget_value, blocking input. */
widget_value *
-xmalloc_widget_value ()
+xmalloc_widget_value (void)
{
widget_value *value;
@@ -601,8 +586,7 @@ xmalloc_widget_value ()
must be left alone. */
void
-free_menubar_widget_value_tree (wv)
- widget_value *wv;
+free_menubar_widget_value_tree (widget_value *wv)
{
if (! wv) return;
@@ -628,8 +612,7 @@ free_menubar_widget_value_tree (wv)
in menu_items starting at index START, up to index END. */
widget_value *
-digest_single_submenu (start, end, top_level_items)
- int start, end, top_level_items;
+digest_single_submenu (int start, int end, int top_level_items)
{
widget_value *wv, *prev_wv, *save_wv, *first_wv;
int i;
@@ -680,7 +663,7 @@ digest_single_submenu (start, end, top_level_items)
{
/* Create a new pane. */
Lisp_Object pane_name, prefix;
- char *pane_string;
+ const char *pane_string;
panes_seen++;
@@ -698,6 +681,12 @@ digest_single_submenu (start, end, top_level_items)
ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
}
+#elif defined (USE_LUCID) && defined (HAVE_XFT)
+ if (STRINGP (pane_name))
+ {
+ pane_name = ENCODE_UTF_8 (pane_name);
+ ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
+ }
#elif !defined (HAVE_MULTILINGUAL_MENU)
if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
{
@@ -707,7 +696,7 @@ digest_single_submenu (start, end, top_level_items)
#endif
pane_string = (NILP (pane_name)
- ? "" : (char *) SDATA (pane_name));
+ ? "" : SSDATA (pane_name));
/* If there is just one top-level pane, put all its items directly
under the top-level menu. */
if (menu_items_n_panes == 1)
@@ -771,6 +760,18 @@ digest_single_submenu (start, end, top_level_items)
descrip = ENCODE_SYSTEM (descrip);
ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
}
+#elif USE_LUCID
+ if (STRINGP (item_name))
+ {
+ item_name = ENCODE_UTF_8 (item_name);
+ ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
+ }
+
+ if (STRINGP (descrip))
+ {
+ descrip = ENCODE_UTF_8 (descrip);
+ ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
+ }
#elif !defined (HAVE_MULTILINGUAL_MENU)
if (STRING_MULTIBYTE (item_name))
{
@@ -839,8 +840,7 @@ digest_single_submenu (start, end, top_level_items)
tree is constructed, and small strings are relocated. So we must wait
until no GC can happen before storing pointers into lisp values. */
void
-update_submenu_strings (first_wv)
- widget_value *first_wv;
+update_submenu_strings (widget_value *first_wv)
{
widget_value *wv;
@@ -848,7 +848,7 @@ update_submenu_strings (first_wv)
{
if (STRINGP (wv->lname))
{
- wv->name = (char *) SDATA (wv->lname);
+ wv->name = SSDATA (wv->lname);
/* Ignore the @ that means "separate pane".
This is a kludge, but this isn't worth more time. */
@@ -861,7 +861,7 @@ update_submenu_strings (first_wv)
}
if (STRINGP (wv->lkey))
- wv->key = (char *) SDATA (wv->lkey);
+ wv->key = SSDATA (wv->lkey);
if (wv->contents)
update_submenu_strings (wv->contents);
@@ -874,11 +874,7 @@ update_submenu_strings (first_wv)
VECTOR is an array of menu events for the whole menu. */
void
-find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
- FRAME_PTR f;
- EMACS_INT menu_bar_items_used;
- Lisp_Object vector;
- void *client_data;
+find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data)
{
Lisp_Object prefix, entry;
Lisp_Object *subprefix_stack;
@@ -955,15 +951,406 @@ find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
}
}
-#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NTGUI */
+#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */
+
+#ifdef HAVE_NS
+/* As above, but return the menu selection instead of storing in kb buffer.
+ If keymaps==1, return full prefixes to selection. */
+Lisp_Object
+find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data)
+{
+ Lisp_Object prefix, entry;
+ int i;
+ Lisp_Object *subprefix_stack;
+ int submenu_depth = 0;
+
+ prefix = entry = Qnil;
+ i = 0;
+ subprefix_stack =
+ (Lisp_Object *)alloca(menu_items_used * sizeof (Lisp_Object));
+
+ while (i < menu_items_used)
+ {
+ if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ {
+ subprefix_stack[submenu_depth++] = prefix;
+ prefix = entry;
+ i++;
+ }
+ else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ {
+ prefix = subprefix_stack[--submenu_depth];
+ i++;
+ }
+ else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ {
+ prefix
+ = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ i += MENU_ITEMS_PANE_LENGTH;
+ }
+ /* Ignore a nil in the item list.
+ It's meaningful only for dialog boxes. */
+ else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ i += 1;
+ else
+ {
+ entry
+ = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
+ if ((EMACS_INT)client_data == (EMACS_INT)(&XVECTOR (menu_items)->contents[i]))
+ {
+ if (keymaps != 0)
+ {
+ int j;
+
+ entry = Fcons (entry, Qnil);
+ if (!NILP (prefix))
+ entry = Fcons (prefix, entry);
+ for (j = submenu_depth - 1; j >= 0; j--)
+ if (!NILP (subprefix_stack[j]))
+ entry = Fcons (subprefix_stack[j], entry);
+ }
+ return entry;
+ }
+ i += MENU_ITEMS_ITEM_LENGTH;
+ }
+ }
+ return Qnil;
+}
+#endif /* HAVE_NS */
+
+DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
+ doc: /* Pop up a deck-of-cards menu and return user's selection.
+POSITION is a position specification. This is either a mouse button event
+or a list ((XOFFSET YOFFSET) WINDOW)
+where XOFFSET and YOFFSET are positions in pixels from the top left
+corner of WINDOW. (WINDOW may be a window or a frame object.)
+This controls the position of the top left of the menu as a whole.
+If POSITION is t, it means to use the current mouse position.
+
+MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
+The menu items come from key bindings that have a menu string as well as
+a definition; actually, the "definition" in such a key binding looks like
+\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
+the keymap as a top-level element.
+
+If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
+Otherwise, REAL-DEFINITION should be a valid key binding definition.
+
+You can also use a list of keymaps as MENU.
+ Then each keymap makes a separate pane.
+
+When MENU is a keymap or a list of keymaps, the return value is the
+list of events corresponding to the user's choice. Note that
+`x-popup-menu' does not actually execute the command bound to that
+sequence of events.
+
+Alternatively, you can specify a menu of multiple panes
+ with a list of the form (TITLE PANE1 PANE2...),
+where each pane is a list of form (TITLE ITEM1 ITEM2...).
+Each ITEM is normally a cons cell (STRING . VALUE);
+but a string can appear as an item--that makes a nonselectable line
+in the menu.
+With this form of menu, the return value is VALUE from the chosen item.
+
+If POSITION is nil, don't display the menu at all, just precalculate the
+cached information about equivalent key sequences.
+
+If the user gets rid of the menu without making a valid choice, for
+instance by clicking the mouse away from a valid choice or by typing
+keyboard input, then this normally results in a quit and
+`x-popup-menu' does not return. But if POSITION is a mouse button
+event (indicating that the user invoked the menu with the mouse) then
+no quit occurs and `x-popup-menu' returns nil. */)
+ (Lisp_Object position, Lisp_Object menu)
+{
+ Lisp_Object keymap, tem;
+ int xpos = 0, ypos = 0;
+ Lisp_Object title;
+ const char *error_name = NULL;
+ Lisp_Object selection = Qnil;
+ FRAME_PTR f = NULL;
+ Lisp_Object x, y, window;
+ int keymaps = 0;
+ int for_click = 0;
+ int specpdl_count = SPECPDL_INDEX ();
+ struct gcpro gcpro1;
+
+ if (NILP (position))
+ /* This is an obsolete call, which wants us to precompute the
+ keybinding equivalents, but we don't do that any more anyway. */
+ return Qnil;
+
+#ifdef HAVE_MENUS
+ {
+ int get_current_pos_p = 0;
+ /* FIXME!! check_w32 (); or check_x (); or check_ns (); */
+
+ /* Decode the first argument: find the window and the coordinates. */
+ if (EQ (position, Qt)
+ || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
+ || EQ (XCAR (position), Qtool_bar))))
+ {
+ get_current_pos_p = 1;
+ }
+ else
+ {
+ tem = Fcar (position);
+ if (CONSP (tem))
+ {
+ window = Fcar (Fcdr (position));
+ x = XCAR (tem);
+ y = Fcar (XCDR (tem));
+ }
+ else
+ {
+ for_click = 1;
+ tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
+ window = Fcar (tem); /* POSN_WINDOW (tem) */
+ tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
+ x = Fcar (tem);
+ y = Fcdr (tem);
+ }
+
+ /* If a click happens in an external tool bar or a detached
+ tool bar, x and y is NIL. In that case, use the current
+ mouse position. This happens for the help button in the
+ tool bar. Ideally popup-menu should pass NIL to
+ this function, but it doesn't. */
+ if (NILP (x) && NILP (y))
+ get_current_pos_p = 1;
+ }
+
+ if (get_current_pos_p)
+ {
+ /* Use the mouse's current position. */
+ FRAME_PTR new_f = SELECTED_FRAME ();
+#ifdef HAVE_X_WINDOWS
+ /* Can't use mouse_position_hook for X since it returns
+ coordinates relative to the window the mouse is in,
+ we need coordinates relative to the edit widget always. */
+ if (new_f != 0)
+ {
+ int cur_x, cur_y;
+
+ mouse_position_for_popup (new_f, &cur_x, &cur_y);
+ /* cur_x/y may be negative, so use make_number. */
+ x = make_number (cur_x);
+ y = make_number (cur_y);
+ }
+
+#else /* not HAVE_X_WINDOWS */
+ Lisp_Object bar_window;
+ enum scroll_bar_part part;
+ unsigned long time;
+ void (*mouse_position_hook) (struct frame **, int,
+ Lisp_Object *,
+ enum scroll_bar_part *,
+ Lisp_Object *,
+ Lisp_Object *,
+ unsigned long *) =
+ FRAME_TERMINAL (new_f)->mouse_position_hook;
+
+ if (mouse_position_hook)
+ (*mouse_position_hook) (&new_f, 1, &bar_window,
+ &part, &x, &y, &time);
+#endif /* not HAVE_X_WINDOWS */
+
+ if (new_f != 0)
+ XSETFRAME (window, new_f);
+ else
+ {
+ window = selected_window;
+ XSETFASTINT (x, 0);
+ XSETFASTINT (y, 0);
+ }
+ }
+
+ CHECK_NUMBER (x);
+ CHECK_NUMBER (y);
+
+ /* Decode where to put the menu. */
+
+ if (FRAMEP (window))
+ {
+ f = XFRAME (window);
+ xpos = 0;
+ ypos = 0;
+ }
+ else if (WINDOWP (window))
+ {
+ struct window *win = XWINDOW (window);
+ CHECK_LIVE_WINDOW (window);
+ f = XFRAME (WINDOW_FRAME (win));
+
+ xpos = WINDOW_LEFT_EDGE_X (win);
+ ypos = WINDOW_TOP_EDGE_Y (win);
+ }
+ else
+ /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
+ but I don't want to make one now. */
+ CHECK_WINDOW (window);
+
+ xpos += XINT (x);
+ ypos += XINT (y);
+
+ /* FIXME: Find a more general check! */
+ if (!(FRAME_X_P (f) || FRAME_MSDOS_P (f)
+ || FRAME_W32_P (f) || FRAME_NS_P (f)))
+ error ("Can not put GUI menu on this terminal");
+
+ XSETFRAME (Vmenu_updating_frame, f);
+ }
+#endif /* HAVE_MENUS */
+
+ /* Now parse the lisp menus. */
+ record_unwind_protect (unuse_menu_items, Qnil);
+
+ title = Qnil;
+ GCPRO1 (title);
+
+ /* Decode the menu items from what was specified. */
+
+ keymap = get_keymap (menu, 0, 0);
+ if (CONSP (keymap))
+ {
+ /* We were given a keymap. Extract menu info from the keymap. */
+ Lisp_Object prompt;
+
+ /* Extract the detailed info to make one pane. */
+ keymap_panes (&menu, 1);
+
+ /* Search for a string appearing directly as an element of the keymap.
+ That string is the title of the menu. */
+ prompt = Fkeymap_prompt (keymap);
+ if (!NILP (prompt))
+ title = prompt;
+#ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */
+ else
+ title = build_string ("Select");
+#endif
+
+ /* Make that be the pane title of the first pane. */
+ if (!NILP (prompt) && menu_items_n_panes >= 0)
+ ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
+
+ keymaps = 1;
+ }
+ else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
+ {
+ /* We were given a list of keymaps. */
+ int nmaps = XFASTINT (Flength (menu));
+ Lisp_Object *maps
+ = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
+ int i;
+
+ title = Qnil;
+
+ /* The first keymap that has a prompt string
+ supplies the menu title. */
+ for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
+ {
+ Lisp_Object prompt;
+
+ maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
+
+ prompt = Fkeymap_prompt (keymap);
+ if (NILP (title) && !NILP (prompt))
+ title = prompt;
+ }
+
+ /* Extract the detailed info to make one pane. */
+ keymap_panes (maps, nmaps);
+
+ /* Make the title be the pane title of the first pane. */
+ if (!NILP (title) && menu_items_n_panes >= 0)
+ ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
+
+ keymaps = 1;
+ }
+ else
+ {
+ /* We were given an old-fashioned menu. */
+ title = Fcar (menu);
+ CHECK_STRING (title);
+
+ list_of_panes (Fcdr (menu));
+
+ keymaps = 0;
+ }
+
+ unbind_to (specpdl_count, Qnil);
+
+#ifdef HAVE_MENUS
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Hide a previous tip, if any. */
+ Fx_hide_tip ();
+#endif
+
+#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
+ /* If resources from a previous popup menu still exist, does nothing
+ until the `menu_free_timer' has freed them (see w32fns.c). This
+ can occur if you press ESC or click outside a menu without selecting
+ a menu item.
+ */
+ if (current_popup_menu)
+ {
+ discard_menu_items ();
+ FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
+ UNGCPRO;
+ return Qnil;
+ }
+#endif
+
+#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
+ record_unwind_protect (cleanup_popup_menu, Qnil);
+#endif
+
+ /* Display them in a menu. */
+ BLOCK_INPUT;
+
+ /* FIXME: Use a terminal hook! */
+#if defined HAVE_NTGUI
+ selection = w32_menu_show (f, xpos, ypos, for_click,
+ keymaps, title, &error_name);
+#elif defined HAVE_NS
+ selection = ns_menu_show (f, xpos, ypos, for_click,
+ keymaps, title, &error_name);
+#else /* MSDOS and X11 */
+ /* Assume last_event_timestamp is the timestamp of the button event.
+ Is this assumption ever violated? We can't use the timestamp
+ stored within POSITION because there the top bits from the actual
+ timestamp may be truncated away (Bug#4930). */
+ selection = xmenu_show (f, xpos, ypos, for_click,
+ keymaps, title, &error_name,
+ last_event_timestamp);
+#endif
+
+ UNBLOCK_INPUT;
+
+#ifdef HAVE_NS
+ unbind_to (specpdl_count, Qnil);
+#else
+ discard_menu_items ();
+#endif
+
+#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */
+ FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
+#endif
+
+#endif /* HAVE_MENUS */
+
+ UNGCPRO;
+
+ if (error_name) error (error_name);
+ return selection;
+}
void
-syms_of_menu ()
+syms_of_menu (void)
{
staticpro (&menu_items);
menu_items = Qnil;
menu_items_inuse = Qnil;
-}
-/* arch-tag: 78bbc7cf-8025-4156-aa8a-6c7fd99bf51d
- (do not change this comment) */
+ defsubr (&Sx_popup_menu);
+}