X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f46305c86cd247b2396e73ce8bb064f69373834d..2bfa3d3e1fb347ba76bddf77f3e288049635821d:/src/menu.c diff --git a/src/menu.c b/src/menu.c index 58558d5aed..240f8734dc 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1,6 +1,6 @@ /* Platform-independent code for terminal communications. -Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2013 Free Software +Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -30,6 +30,7 @@ along with GNU Emacs. If not, see . */ #include "termhooks.h" #include "blockinput.h" #include "dispextern.h" +#include "buffer.h" #ifdef USE_X_TOOLKIT #include "../lwlib/lwlib.h" @@ -50,18 +51,21 @@ extern HMENU current_popup_menu; #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 +/* Return non-zero if menus can handle radio and toggle buttons. */ +static bool +have_boxes (void) +{ +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined(HAVE_NS) + if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))) + return 1; #endif + return 0; +} Lisp_Object menu_items; /* If non-nil, means that the global vars defined here are already in use. Used to detect cases where we try to re-enter this non-reentrant code. */ -#if ! (defined USE_GTK || defined USE_MOTIF) -static -#endif Lisp_Object menu_items_inuse; /* Number of slots currently allocated in menu_items. */ @@ -102,10 +106,10 @@ finish_menu_items (void) { } -Lisp_Object -unuse_menu_items (Lisp_Object dummy) +void +unuse_menu_items (void) { - return menu_items_inuse = Qnil; + menu_items_inuse = Qnil; } /* Call when finished using the data for the current menu @@ -124,19 +128,10 @@ discard_menu_items (void) eassert (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 +static void restore_menu_items (Lisp_Object saved) { menu_items = XCAR (saved); @@ -148,7 +143,6 @@ restore_menu_items (Lisp_Object saved) menu_items_n_panes = XINT (XCAR (saved)); saved = XCDR (saved); menu_items_submenu_depth = XINT (XCAR (saved)); - return Qnil; } /* Push the whole state of menu_items processing onto the specpdl. @@ -293,13 +287,14 @@ single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name, push_menu_pane (pane_name, prefix); -#ifndef HAVE_BOXES - /* Remember index for first item in this pane so we can go back and - add a prefix when (if) we see the first button. After that, notbuttons - is set to 0, to mark that we have seen a button and all non button - items need a prefix. */ - skp.notbuttons = menu_items_used; -#endif + if (!have_boxes ()) + { + /* Remember index for first item in this pane so we can go back + and add a prefix when (if) we see the first button. After + that, notbuttons is set to 0, to mark that we have seen a + button and all non button items need a prefix. */ + skp.notbuttons = menu_items_used; + } GCPRO1 (skp.pending_maps); map_keymap_canonical (keymap, single_menu_item, Qnil, &skp); @@ -355,77 +350,73 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk return; } -#if defined (HAVE_X_WINDOWS) || defined (MSDOS) -#ifndef HAVE_BOXES /* Simulate radio buttons and toggle boxes by putting a prefix in front of them. */ - { - Lisp_Object prefix = Qnil; - Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE); - if (!NILP (type)) - { - Lisp_Object selected - = AREF (item_properties, ITEM_PROPERTY_SELECTED); + if (!have_boxes ()) + { + Lisp_Object prefix = Qnil; + Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE); + if (!NILP (type)) + { + Lisp_Object selected + = AREF (item_properties, ITEM_PROPERTY_SELECTED); - if (skp->notbuttons) - /* The first button. Line up previous items in this menu. */ - { - int idx = skp->notbuttons; /* Index for first item this menu. */ - int submenu = 0; - Lisp_Object tem; - while (idx < menu_items_used) - { - tem - = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME); - if (NILP (tem)) - { - idx++; - submenu++; /* Skip sub menu. */ - } - else if (EQ (tem, Qlambda)) - { - idx++; - submenu--; /* End sub menu. */ - } - else if (EQ (tem, Qt)) - idx += 3; /* Skip new pane marker. */ - else if (EQ (tem, Qquote)) - idx++; /* Skip a left, right divider. */ - else - { - if (!submenu && SREF (tem, 0) != '\0' - && SREF (tem, 0) != '-') - ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME, - concat2 (build_string (" "), tem)); - idx += MENU_ITEMS_ITEM_LENGTH; - } - } - skp->notbuttons = 0; - } + if (skp->notbuttons) + /* The first button. Line up previous items in this menu. */ + { + int idx = skp->notbuttons; /* Index for first item this menu. */ + int submenu = 0; + Lisp_Object tem; + while (idx < menu_items_used) + { + tem + = AREF (menu_items, idx + MENU_ITEMS_ITEM_NAME); + if (NILP (tem)) + { + idx++; + submenu++; /* Skip sub menu. */ + } + else if (EQ (tem, Qlambda)) + { + idx++; + submenu--; /* End sub menu. */ + } + else if (EQ (tem, Qt)) + idx += 3; /* Skip new pane marker. */ + else if (EQ (tem, Qquote)) + idx++; /* Skip a left, right divider. */ + else + { + if (!submenu && SREF (tem, 0) != '\0' + && SREF (tem, 0) != '-') + ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME, + concat2 (build_string (" "), tem)); + idx += MENU_ITEMS_ITEM_LENGTH; + } + } + skp->notbuttons = 0; + } - /* Calculate prefix, if any, for this item. */ - if (EQ (type, QCtoggle)) - prefix = build_string (NILP (selected) ? "[ ] " : "[X] "); - else if (EQ (type, QCradio)) - prefix = build_string (NILP (selected) ? "( ) " : "(*) "); - } - /* Not a button. If we have earlier buttons, then we need a prefix. */ - else if (!skp->notbuttons && SREF (item_string, 0) != '\0' - && SREF (item_string, 0) != '-') - prefix = build_string (" "); + /* Calculate prefix, if any, for this item. */ + if (EQ (type, QCtoggle)) + prefix = build_string (NILP (selected) ? "[ ] " : "[X] "); + else if (EQ (type, QCradio)) + prefix = build_string (NILP (selected) ? "( ) " : "(*) "); + } + /* Not a button. If we have earlier buttons, then we need a prefix. */ + else if (!skp->notbuttons && SREF (item_string, 0) != '\0' + && SREF (item_string, 0) != '-') + prefix = build_string (" "); - if (!NILP (prefix)) - item_string = concat2 (prefix, item_string); + if (!NILP (prefix)) + item_string = concat2 (prefix, item_string); } -#endif /* not HAVE_BOXES */ -#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) - if (!NILP (map)) + if ((FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)) + || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame))) + && !NILP (map)) /* Indicate visually that this is a submenu. */ item_string = concat2 (item_string, build_string (" >")); -#endif - -#endif /* HAVE_X_WINDOWS || MSDOS */ push_menu_item (item_string, enabled, key, AREF (item_properties, ITEM_PROPERTY_DEF), @@ -436,7 +427,8 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk #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))) + if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)) + && ! (NILP (map) || NILP (enabled))) { push_submenu_start (); single_keymap_panes (map, Qnil, key, skp->maxdepth - 1); @@ -465,6 +457,16 @@ keymap_panes (Lisp_Object *keymaps, ptrdiff_t nmaps) finish_menu_items (); } +/* Encode a menu string as appropriate for menu-updating-frame's type. */ +static Lisp_Object +encode_menu_string (Lisp_Object str) +{ + /* TTY menu strings are encoded by write_glyphs, when they are + delivered to the glass, so no need to encode them here. */ + if (FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))) + return str; + return ENCODE_MENU_STRING (str); +} /* Push the items in a single pane defined by the alist PANE. */ static void @@ -476,13 +478,13 @@ list_of_items (Lisp_Object pane) { item = XCAR (tail); if (STRINGP (item)) - push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt, + push_menu_item (encode_menu_string (item), Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil); else if (CONSP (item)) { item1 = XCAR (item); CHECK_STRING (item1); - push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item), + push_menu_item (encode_menu_string (item1), Qt, XCDR (item), Qt, Qnil, Qnil, Qnil, Qnil); } else @@ -507,7 +509,7 @@ list_of_panes (Lisp_Object menu) elt = XCAR (tail); pane_name = Fcar (elt); CHECK_STRING (pane_name); - push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil); + push_menu_pane (encode_menu_string (pane_name), Qnil); pane_data = Fcdr (elt); CHECK_CONS (pane_data); list_of_items (pane_data); @@ -571,21 +573,26 @@ parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI) -/* Allocate a widget_value, blocking input. */ +/* Allocate and basically initialize widget_value, blocking input. */ widget_value * -xmalloc_widget_value (void) +make_widget_value (const char *name, char *value, + bool enabled, Lisp_Object help) { - widget_value *value; + widget_value *wv; block_input (); - value = malloc_widget_value (); + wv = xzalloc (sizeof (widget_value)); unblock_input (); - return value; + wv->name = (char *) name; + wv->value = value; + wv->enabled = enabled; + wv->help = help; + return wv; } -/* This recursively calls free_widget_value on the tree of widgets. +/* This recursively calls xfree on the tree of widgets. It must free all data that was malloc'ed for these widget_values. In Emacs, many slots are pointers into the data of Lisp_Strings, and must be left alone. */ @@ -608,7 +615,7 @@ free_menubar_widget_value_tree (widget_value *wv) wv->next = (widget_value *) 0xDEADBEEF; } block_input (); - free_widget_value (wv); + xfree (wv); unblock_input (); } @@ -624,14 +631,11 @@ digest_single_submenu (int start, int end, bool top_level_items) int submenu_depth = 0; widget_value **submenu_stack; bool panes_seen = 0; + struct frame *f = XFRAME (Vmenu_updating_frame); submenu_stack = alloca (menu_items_used * sizeof *submenu_stack); - wv = xmalloc_widget_value (); - wv->name = "menu"; - wv->value = 0; - wv->enabled = 1; + wv = make_widget_value ("menu", NULL, true, Qnil); wv->button_type = BUTTON_TYPE_NONE; - wv->help = Qnil; first_wv = wv; save_wv = 0; prev_wv = 0; @@ -673,30 +677,35 @@ digest_single_submenu (int start, int end, bool top_level_items) pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); -#ifdef HAVE_NTGUI - if (STRINGP (pane_name)) + /* TTY menus display menu items via tty_write_glyphs, which + will encode the strings as appropriate. */ + if (!FRAME_TERMCAP_P (f)) { - if (unicode_append_menu) - /* Encode as UTF-8 for now. */ - pane_name = ENCODE_UTF_8 (pane_name); - else if (STRING_MULTIBYTE (pane_name)) - pane_name = ENCODE_SYSTEM (pane_name); +#ifdef HAVE_NTGUI + if (STRINGP (pane_name)) + { + if (unicode_append_menu) + /* Encode as UTF-8 for now. */ + pane_name = ENCODE_UTF_8 (pane_name); + else if (STRING_MULTIBYTE (pane_name)) + pane_name = ENCODE_SYSTEM (pane_name); - ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); - } + 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); - } + 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)) - { - pane_name = ENCODE_MENU_STRING (pane_name); - ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); - } + if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) + { + pane_name = ENCODE_MENU_STRING (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } #endif + } pane_string = (NILP (pane_name) ? "" : SSDATA (pane_name)); @@ -710,17 +719,14 @@ digest_single_submenu (int start, int end, bool top_level_items) with its items as a submenu beneath it. */ if (strcmp (pane_string, "")) { - wv = xmalloc_widget_value (); + /* Set value to 1 so update_submenu_strings can handle '@'. */ + wv = make_widget_value (NULL, (char *) 1, true, Qnil); if (save_wv) save_wv->next = wv; else first_wv->contents = wv; wv->lname = pane_name; - /* Set value to 1 so update_submenu_strings can handle '@' */ - wv->value = (char *)1; - wv->enabled = 1; wv->button_type = BUTTON_TYPE_NONE; - wv->help = Qnil; save_wv = wv; } else @@ -747,49 +753,55 @@ digest_single_submenu (int start, int end, bool top_level_items) selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); -#ifdef HAVE_NTGUI - if (STRINGP (item_name)) + /* TTY menu items and their descriptions will be encoded by + tty_write_glyphs. */ + if (!FRAME_TERMCAP_P (f)) { - if (unicode_append_menu) - item_name = ENCODE_UTF_8 (item_name); - else if (STRING_MULTIBYTE (item_name)) - item_name = ENCODE_SYSTEM (item_name); +#ifdef HAVE_NTGUI + if (STRINGP (item_name)) + { + if (unicode_append_menu) + item_name = ENCODE_UTF_8 (item_name); + else if (STRING_MULTIBYTE (item_name)) + item_name = ENCODE_SYSTEM (item_name); - ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); - } + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } - if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) - { - descrip = ENCODE_SYSTEM (descrip); - ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); - } + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + 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 (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); - } + 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)) - { - item_name = ENCODE_MENU_STRING (item_name); - ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); - } + if (STRING_MULTIBYTE (item_name)) + { + item_name = ENCODE_MENU_STRING (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } - if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) - { - descrip = ENCODE_MENU_STRING (descrip); - ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); - } + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + descrip = ENCODE_MENU_STRING (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } #endif + } - wv = xmalloc_widget_value (); + wv = make_widget_value (NULL, NULL, !NILP (enable), + STRINGP (help) ? help : Qnil); if (prev_wv) prev_wv->next = wv; else @@ -798,11 +810,9 @@ digest_single_submenu (int start, int end, bool top_level_items) wv->lname = item_name; if (!NILP (descrip)) wv->lkey = descrip; - wv->value = 0; /* The intptr_t cast avoids a warning. There's no problem as long as pointers have enough bits to hold small integers. */ wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0); - wv->enabled = !NILP (enable); if (NILP (type)) wv->button_type = BUTTON_TYPE_NONE; @@ -814,10 +824,6 @@ digest_single_submenu (int start, int end, bool top_level_items) emacs_abort (); wv->selected = !NILP (selected); - if (! STRINGP (help)) - help = Qnil; - - wv->help = help; prev_wv = wv; @@ -830,7 +836,7 @@ digest_single_submenu (int start, int end, bool top_level_items) if (top_level_items && first_wv->contents && first_wv->contents->next == 0) { wv = first_wv->contents; - free_widget_value (first_wv); + xfree (first_wv); return wv; } @@ -877,7 +883,8 @@ update_submenu_strings (widget_value *first_wv) VECTOR is an array of menu events for the whole menu. */ void -find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object vector, void *client_data) +find_and_call_menu_selection (struct frame *f, int menu_bar_items_used, + Lisp_Object vector, void *client_data) { Lisp_Object prefix, entry; Lisp_Object *subprefix_stack; @@ -960,7 +967,7 @@ find_and_call_menu_selection (FRAME_PTR f, int menu_bar_items_used, Lisp_Object /* As above, but return the menu selection instead of storing in kb buffer. If KEYMAPS, return full prefixes to selection. */ Lisp_Object -find_and_return_menu_selection (FRAME_PTR f, bool keymaps, void *client_data) +find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data) { Lisp_Object prefix, entry; int i; @@ -1004,7 +1011,7 @@ find_and_return_menu_selection (FRAME_PTR f, bool keymaps, void *client_data) { int j; - entry = Fcons (entry, Qnil); + entry = list1 (entry); if (!NILP (prefix)) entry = Fcons (prefix, entry); for (j = submenu_depth - 1; j >= 0; j--) @@ -1020,6 +1027,85 @@ find_and_return_menu_selection (FRAME_PTR f, bool keymaps, void *client_data) } #endif /* HAVE_NS */ +ptrdiff_t +menu_item_width (const unsigned char *str) +{ + ptrdiff_t len; + const unsigned char *p; + + for (len = 0, p = str; *p; ) + { + int ch_len; + int ch = STRING_CHAR_AND_LENGTH (p, ch_len); + + len += CHAR_WIDTH (ch); + p += ch_len; + } + return len; +} + +DEFUN ("menu-bar-menu-at-x-y", Fmenu_bar_menu_at_x_y, Smenu_bar_menu_at_x_y, + 2, 3, 0, + doc: /* Return the menu-bar menu on FRAME at pixel coordinates X, Y. +X and Y are frame-relative pixel coordinates, assumed to define +a location within the menu bar. +If FRAME is nil or omitted, it defaults to the selected frame. + +Value is the symbol of the menu at X/Y, or nil if the specified +coordinates are not within the FRAME's menu bar. The symbol can +be used to look up the menu like this: + + (lookup-key MAP [menu-bar SYMBOL]) + +where MAP is either the current global map or the current local map, +since menu-bar items come from both. + +This function can return non-nil only on a text-terminal frame +or on an X frame that doesn't use any GUI toolkit. Otherwise, +Emacs does not manage the menu bar and cannot convert coordinates +into menu items. */) + (Lisp_Object x, Lisp_Object y, Lisp_Object frame) +{ + int row, col; + struct frame *f = decode_any_frame (frame); + + if (!FRAME_LIVE_P (f)) + return Qnil; + + pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1); + if (0 <= row && row < FRAME_MENU_BAR_LINES (f)) + { + Lisp_Object items, item; + int i; + + /* Find the menu bar item under `col'. */ + item = Qnil; + items = FRAME_MENU_BAR_ITEMS (f); + /* This loop assumes a single menu-bar line, and will fail to + find an item if it is not in the first line. Note that + make_lispy_event in keyboard.c makes the same assumption. */ + for (i = 0; i < ASIZE (items); i += 4) + { + Lisp_Object pos, str; + + str = AREF (items, i + 1); + pos = AREF (items, i + 3); + if (NILP (str)) + return item; + if (XINT (pos) <= col + /* We use <= so the blank between 2 items on a TTY is + considered part of the previous item. */ + && col <= XINT (pos) + menu_item_width (SDATA (str))) + { + item = AREF (items, i); + return item; + } + } + } + return Qnil; +} + + 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 @@ -1065,29 +1151,29 @@ 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; + Lisp_Object keymap, tem, tem2; int xpos = 0, ypos = 0; Lisp_Object title; const char *error_name = NULL; Lisp_Object selection = Qnil; - FRAME_PTR f = NULL; + struct frame *f = NULL; Lisp_Object x, y, window; - bool keymaps = 0; - bool for_click = 0; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + int menuflags = 0; + dynwind_begin (); + ptrdiff_t specpdl_count2; 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; + { + dynwind_end (); + return Qnil; + } -#ifdef HAVE_MENUS { bool get_current_pos_p = 0; - check_window_system (SELECTED_FRAME ()); - /* Decode the first argument: find the window and the coordinates. */ if (EQ (position, Qt) || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) @@ -1106,9 +1192,25 @@ no quit occurs and `x-popup-menu' returns nil. */) } else { - for_click = 1; + menuflags |= MENU_FOR_CLICK; tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ window = Fcar (tem); /* POSN_WINDOW (tem) */ + tem2 = Fcar (Fcdr (tem)); /* POSN_POSN (tem) */ + /* The MENU_KBD_NAVIGATION field is set when the menu + was invoked by F10, which probably means they have no + mouse. In that case, we let them switch between + top-level menu-bar menus by using C-f/C-b and + horizontal arrow keys, since they cannot click the + mouse to open a different submenu. This flag is only + supported by tty_menu_show. We set it when POSITION + and last_nonmenu_event are different, which means we + constructed POSITION by hand (in popup-menu, see + menu-bar.el) to look like a mouse click on the menu bar + event. */ + if (!EQ (POSN_POSN (last_nonmenu_event), + POSN_POSN (position)) + && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar)) + menuflags |= MENU_KBD_NAVIGATION; tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ x = Fcar (tem); y = Fcdr (tem); @@ -1126,7 +1228,7 @@ no quit occurs and `x-popup-menu' returns nil. */) if (get_current_pos_p) { /* Use the mouse's current position. */ - FRAME_PTR new_f = SELECTED_FRAME (); + struct frame *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, @@ -1135,7 +1237,7 @@ no quit occurs and `x-popup-menu' returns nil. */) { int cur_x, cur_y; - mouse_position_for_popup (new_f, &cur_x, &cur_y); + x_relative_mouse_position (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); @@ -1203,17 +1305,11 @@ no quit occurs and `x-popup-menu' returns nil. */) 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); + record_unwind_protect_void (unuse_menu_items); title = Qnil; GCPRO1 (title); @@ -1243,7 +1339,7 @@ no quit occurs and `x-popup-menu' returns nil. */) if (!NILP (prompt) && menu_items_n_panes >= 0) ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt); - keymaps = 1; + menuflags |= MENU_KEYMAPS; } else if (CONSP (menu) && KEYMAPP (XCAR (menu))) { @@ -1276,7 +1372,7 @@ no quit occurs and `x-popup-menu' returns nil. */) if (!NILP (title) && menu_items_n_panes >= 0) ASET (menu_items, MENU_ITEMS_PANE_NAME, title); - keymaps = 1; + menuflags |= MENU_KEYMAPS; SAFE_FREE (); } @@ -1288,15 +1384,15 @@ no quit occurs and `x-popup-menu' returns nil. */) list_of_panes (Fcdr (menu)); - keymaps = 0; + menuflags &= ~MENU_KEYMAPS; } - unbind_to (specpdl_count, Qnil); + dynwind_end (); -#ifdef HAVE_MENUS #ifdef HAVE_WINDOW_SYSTEM /* Hide a previous tip, if any. */ - Fx_hide_tip (); + if (!FRAME_TERMCAP_P (f)) + Fx_hide_tip (); #endif #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */ @@ -1305,65 +1401,174 @@ no quit occurs and `x-popup-menu' returns nil. */) can occur if you press ESC or click outside a menu without selecting a menu item. */ - if (current_popup_menu) + if (current_popup_menu && FRAME_W32_P (f)) { discard_menu_items (); - FRAME_X_DISPLAY_INFO (f)->grabbed = 0; + FRAME_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 + dynwind_begin (); - /* 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); +#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */ + record_unwind_protect_void (discard_menu_items); #endif - unblock_input (); + /* Display them in a menu, but not if F is the initial frame that + doesn't have its hooks set (e.g., in a batch session), because + such a frame cannot display menus. */ + if (!FRAME_INITIAL_P (f)) + selection = FRAME_TERMINAL (f)->menu_show_hook (f, xpos, ypos, menuflags, + title, &error_name); -#ifdef HAVE_NS - unbind_to (specpdl_count, Qnil); -#else +#ifndef HAVE_NS discard_menu_items (); #endif + dynwind_end (); + #ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */ - FRAME_X_DISPLAY_INFO (f)->grabbed = 0; + if (FRAME_W32_P (f)) + FRAME_DISPLAY_INFO (f)->grabbed = 0; #endif -#endif /* HAVE_MENUS */ - UNGCPRO; if (error_name) error ("%s", error_name); return selection; } +/* If F's terminal is not capable of displaying a popup dialog, + emulate it with a menu. */ + +static Lisp_Object +emulate_dialog_with_menu (struct frame *f, Lisp_Object contents) +{ + Lisp_Object x, y, frame, newpos, prompt = Fcar (contents); + int x_coord, y_coord; + + if (FRAME_WINDOW_P (f)) + { + x_coord = FRAME_PIXEL_WIDTH (f); + y_coord = FRAME_PIXEL_HEIGHT (f); + } + else + { + x_coord = FRAME_COLS (f); + /* Center the title at frame middle. (TTY menus have + their upper-left corner at the given position.) */ + if (STRINGP (prompt)) + x_coord -= SCHARS (prompt); + y_coord = FRAME_LINES (f); + } + + XSETFRAME (frame, f); + XSETINT (x, x_coord / 2); + XSETINT (y, y_coord / 2); + newpos = list2 (list2 (x, y), frame); + + return Fx_popup_menu (newpos, list2 (prompt, contents)); +} + +DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0, + doc: /* Pop up a dialog box and return user's selection. +POSITION specifies which frame to use. +This is normally a mouse button event or a window or frame. +If POSITION is t, it means to use the frame the mouse is on. +The dialog box appears in the middle of the specified frame. + +CONTENTS specifies the alternatives to display in the dialog box. +It is a list of the form (DIALOG ITEM1 ITEM2...). +Each ITEM is a cons cell (STRING . VALUE). +The return value is VALUE from the chosen item. + +An ITEM may also be just a string--that makes a nonselectable item. +An ITEM may also be nil--that means to put all preceding items +on the left of the dialog box and all following items on the right. +\(By default, approximately half appear on each side.) + +If HEADER is non-nil, the frame title for the box is "Information", +otherwise it is "Question". + +If the user gets rid of the dialog box without making a valid choice, +for instance using the window manager, then this produces a quit and +`x-popup-dialog' does not return. */) + (Lisp_Object position, Lisp_Object contents, Lisp_Object header) +{ + struct frame *f = NULL; + Lisp_Object window; + + /* Decode the first argument: find the window or frame to use. */ + if (EQ (position, Qt) + || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) + || EQ (XCAR (position), Qtool_bar)))) + window = selected_window; + else if (CONSP (position)) + { + Lisp_Object tem = XCAR (position); + if (CONSP (tem)) + window = Fcar (XCDR (position)); + else + { + tem = Fcar (XCDR (position)); /* EVENT_START (position) */ + window = Fcar (tem); /* POSN_WINDOW (tem) */ + } + } + else if (WINDOWP (position) || FRAMEP (position)) + window = position; + else + window = Qnil; + + /* Decode where to put the menu. */ + + if (FRAMEP (window)) + f = XFRAME (window); + else if (WINDOWP (window)) + { + CHECK_LIVE_WINDOW (window); + f = XFRAME (WINDOW_FRAME (XWINDOW (window))); + } + else + /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, + but I don't want to make one now. */ + CHECK_WINDOW (window); + + /* Force a redisplay before showing the dialog. If a frame is created + just before showing the dialog, its contents may not have been fully + drawn, as this depends on timing of events from the X server. Redisplay + is not done when a dialog is shown. If redisplay could be done in the + X event loop (i.e. the X event loop does not run in a signal handler) + this would not be needed. + + Do this before creating the widget value that points to Lisp + string contents, because Fredisplay may GC and relocate them. */ + Fredisplay (Qt); + + /* Display the popup dialog by a terminal-specific hook ... */ + if (FRAME_TERMINAL (f)->popup_dialog_hook) + { + Lisp_Object selection + = FRAME_TERMINAL (f)->popup_dialog_hook (f, header, contents); +#ifdef HAVE_NTGUI + /* NTGUI supports only simple dialogs with Yes/No choices. For + other dialogs, it returns the symbol 'unsupported--w32-dialog', + as a signal for the caller to fall back to the emulation code. */ + if (!EQ (selection, Qunsupported__w32_dialog)) +#endif + return selection; + } + /* ... or emulate it with a menu. */ + return emulate_dialog_with_menu (f, contents); +} + void syms_of_menu (void) { +#include "menu.x" + staticpro (&menu_items); menu_items = Qnil; menu_items_inuse = Qnil; - - defsubr (&Sx_popup_menu); }