diff options
Diffstat (limited to 'src/menu.c')
-rw-r--r-- | src/menu.c | 287 |
1 files changed, 160 insertions, 127 deletions
diff --git a/src/menu.c b/src/menu.c index d569b4b29b5..eeb0c9a7e5b 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-2017 Free Software +Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2022 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -19,7 +19,6 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> -#include <stdio.h> #include <limits.h> /* for INT_MAX */ #include "lisp.h" @@ -51,7 +50,8 @@ extern AppendMenuW_Proc unicode_append_menu; static bool have_boxes (void) { -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined(HAVE_NS) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined (HAVE_NS) \ + || defined (HAVE_HAIKU) if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))) return 1; #endif @@ -60,9 +60,9 @@ have_boxes (void) Lisp_Object menu_items; -/* If non-nil, means that the global vars defined here are already in use. +/* Whether the global vars defined here are already in use. Used to detect cases where we try to re-enter this non-reentrant code. */ -Lisp_Object menu_items_inuse; +bool menu_items_inuse; /* Number of slots currently allocated in menu_items. */ int menu_items_allocated; @@ -80,16 +80,16 @@ static int menu_items_submenu_depth; void init_menu_items (void) { - if (!NILP (menu_items_inuse)) + if (menu_items_inuse) error ("Trying to use a menu from within a menu-entry"); if (NILP (menu_items)) { menu_items_allocated = 60; - menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); + menu_items = make_nil_vector (menu_items_allocated); } - menu_items_inuse = Qt; + menu_items_inuse = true; menu_items_used = 0; menu_items_n_panes = 0; menu_items_submenu_depth = 0; @@ -105,7 +105,7 @@ finish_menu_items (void) void unuse_menu_items (void) { - menu_items_inuse = Qnil; + menu_items_inuse = false; } /* Call when finished using the data for the current menu @@ -121,7 +121,7 @@ discard_menu_items (void) menu_items = Qnil; menu_items_allocated = 0; } - eassert (NILP (menu_items_inuse)); + eassert (!menu_items_inuse); } /* This undoes save_menu_items, and it is called by the specpdl unwind @@ -131,14 +131,14 @@ static void restore_menu_items (Lisp_Object saved) { menu_items = XCAR (saved); - menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil); + menu_items_inuse = ! NILP (menu_items); menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0); saved = XCDR (saved); - menu_items_used = XINT (XCAR (saved)); + menu_items_used = XFIXNUM (XCAR (saved)); saved = XCDR (saved); - menu_items_n_panes = XINT (XCAR (saved)); + menu_items_n_panes = XFIXNUM (XCAR (saved)); saved = XCDR (saved); - menu_items_submenu_depth = XINT (XCAR (saved)); + menu_items_submenu_depth = XFIXNUM (XCAR (saved)); } /* Push the whole state of menu_items processing onto the specpdl. @@ -147,12 +147,12 @@ restore_menu_items (Lisp_Object saved) void save_menu_items (void) { - Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil, - make_number (menu_items_used), - make_number (menu_items_n_panes), - make_number (menu_items_submenu_depth)); + Lisp_Object saved = list4 (menu_items_inuse ? menu_items : Qnil, + make_fixnum (menu_items_used), + make_fixnum (menu_items_n_panes), + make_fixnum (menu_items_submenu_depth)); record_unwind_protect (restore_menu_items, saved); - menu_items_inuse = Qnil; + menu_items_inuse = false; menu_items = Qnil; } @@ -170,8 +170,7 @@ ensure_menu_items (int items) } } -#if (defined USE_X_TOOLKIT || defined USE_GTK || defined HAVE_NS \ - || defined HAVE_NTGUI) +#ifdef HAVE_EXT_MENU_BAR /* Begin a submenu. */ @@ -195,7 +194,7 @@ push_submenu_end (void) menu_items_submenu_depth--; } -#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || defined HAVE_NTGUI */ +#endif /* HAVE_EXT_MENU_BAR */ /* Indicate boundary between left and right. */ @@ -424,7 +423,8 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk AREF (item_properties, ITEM_PROPERTY_SELECTED), AREF (item_properties, ITEM_PROPERTY_HELP)); -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) \ + || defined (HAVE_NTGUI) || defined (HAVE_HAIKU) || defined (HAVE_PGTK) /* Display a submenu using the toolkit. */ if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)) && ! (NILP (map) || NILP (enabled))) @@ -524,19 +524,15 @@ bool parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps) { - Lisp_Object length; - EMACS_INT len; Lisp_Object *mapvec; - ptrdiff_t i; bool top_level_items = 0; USE_SAFE_ALLOCA; - length = Flength (maps); - len = XINT (length); + ptrdiff_t len = list_length (maps); /* Convert the list MAPS into a vector MAPVEC. */ SAFE_ALLOCA_LISP (mapvec, len); - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { mapvec[i] = Fcar (maps); maps = Fcdr (maps); @@ -544,7 +540,7 @@ parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, /* Loop over the given keymaps, making a pane for each map. But don't make a pane that is empty--ignore that map instead. */ - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { if (!KEYMAPP (mapvec[i])) { @@ -647,7 +643,7 @@ digest_single_submenu (int start, int end, bool top_level_items) i = start; while (i < end) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; @@ -692,7 +688,7 @@ digest_single_submenu (int start, int end, bool top_level_items) ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); } -#elif defined (USE_LUCID) && defined (HAVE_XFT) +#elif defined (USE_LUCID) && (defined USE_CAIRO || defined HAVE_XFT) if (STRINGP (pane_name)) { pane_name = ENCODE_UTF_8 (pane_name); @@ -878,6 +874,10 @@ update_submenu_strings (widget_value *first_wv) } } +#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */ +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) \ + || defined (HAVE_NTGUI) || defined (HAVE_HAIKU) + /* Find the menu selection and store it in the keyboard buffer. F is the frame the menu is on. MENU_BAR_ITEMS_USED is the length of VECTOR. @@ -900,7 +900,7 @@ find_and_call_menu_selection (struct frame *f, int menu_bar_items_used, while (i < menu_bar_items_used) { - if (EQ (AREF (vector, i), Qnil)) + if (NILP (AREF (vector, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; @@ -965,7 +965,7 @@ find_and_call_menu_selection (struct frame *f, int menu_bar_items_used, SAFE_FREE (); } -#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */ +#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI || HAVE_HAIKU */ #ifdef HAVE_NS /* As above, but return the menu selection instead of storing in kb buffer. @@ -985,7 +985,7 @@ find_and_return_menu_selection (struct frame *f, bool keymaps, void *client_data while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; @@ -1042,9 +1042,7 @@ menu_item_width (const unsigned char *str) for (len = 0, p = str; *p; ) { - int ch_len; - int ch = STRING_CHAR_AND_LENGTH (p, ch_len); - + int ch_len, ch = string_char_and_length (p, &ch_len); len += CHARACTER_WIDTH (ch); p += ch_len; } @@ -1079,7 +1077,7 @@ into menu items. */) if (!FRAME_LIVE_P (f)) return Qnil; - pixel_to_glyph_coords (f, XINT (x), XINT (y), &col, &row, NULL, 1); + pixel_to_glyph_coords (f, XFIXNUM (x), XFIXNUM (y), &col, &row, NULL, 1); if (0 <= row && row < FRAME_MENU_BAR_LINES (f)) { Lisp_Object items, item; @@ -1099,10 +1097,10 @@ into menu items. */) pos = AREF (items, i + 3); if (NILP (str)) return item; - if (XINT (pos) <= col + if (XFIXNUM (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))) + && col <= XFIXNUM (pos) + menu_item_width (SDATA (str))) { item = AREF (items, i); return item; @@ -1112,61 +1110,18 @@ into menu items. */) 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 -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 +x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) { - Lisp_Object keymap, tem, tem2; + Lisp_Object keymap, tem, tem2 = Qnil; int xpos = 0, ypos = 0; Lisp_Object title; const char *error_name = NULL; Lisp_Object selection = Qnil; - struct frame *f = NULL; + struct frame *f; Lisp_Object x, y, window; int menuflags = 0; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); if (NILP (position)) /* This is an obsolete call, which wants us to precompute the @@ -1178,8 +1133,12 @@ no quit occurs and `x-popup-menu' returns nil. */) /* 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)))) + || (CONSP (position) + && (EQ (XCAR (position), Qmenu_bar) + || EQ (XCAR (position), Qtab_bar) + || (CONSP (XCDR (position)) + && EQ (XCAR (XCDR (position)), Qtab_bar)) + || EQ (XCAR (position), Qtool_bar)))) { get_current_pos_p = 1; } @@ -1195,7 +1154,7 @@ no quit occurs and `x-popup-menu' returns nil. */) else { menuflags |= MENU_FOR_CLICK; - tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ + tem = Fcar (XCDR (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 @@ -1211,7 +1170,7 @@ no quit occurs and `x-popup-menu' returns nil. */) event. */ if (!EQ (POSN_POSN (last_nonmenu_event), POSN_POSN (position)) - && CONSP (tem2) && EQ (Fcar (tem2), Qmenu_bar)) + && CONSP (tem2) && EQ (XCAR (tem2), Qmenu_bar)) menuflags |= MENU_KBD_NAVIGATION; tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ x = Fcar (tem); @@ -1245,9 +1204,9 @@ no quit occurs and `x-popup-menu' returns nil. */) int 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); + /* cur_x/y may be negative, so use make_fixnum. */ + x = make_fixnum (cur_x); + y = make_fixnum (cur_y); } } else @@ -1293,26 +1252,37 @@ no quit occurs and `x-popup-menu' returns nil. */) CHECK_LIVE_WINDOW (window); f = XFRAME (WINDOW_FRAME (win)); - xpos = WINDOW_LEFT_EDGE_X (win); - ypos = WINDOW_TOP_EDGE_Y (win); + if (FIXNUMP (tem2)) + { + /* Clicks in the text area, where TEM2 is a buffer + position, are relative to the top-left edge of the text + area, see keyboard.c:make_lispy_position. */ + xpos = window_box_left (win, TEXT_AREA); + ypos = (WINDOW_TOP_EDGE_Y (win) + + WINDOW_TAB_LINE_HEIGHT (win) + + WINDOW_HEADER_LINE_HEIGHT (win)); + } + else + { + xpos = WINDOW_LEFT_EDGE_X (win); + ypos = WINDOW_TOP_EDGE_Y (win); + } } else - /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, + /* ??? Not really clean; should be Qwindow_or_framep but I don't want to make one now. */ - CHECK_WINDOW (window); - - CHECK_RANGED_INTEGER (x, - (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM - ? (EMACS_INT) INT_MIN - xpos - : MOST_NEGATIVE_FIXNUM), - INT_MAX - xpos); - CHECK_RANGED_INTEGER (y, - (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM - ? (EMACS_INT) INT_MIN - ypos - : MOST_NEGATIVE_FIXNUM), - INT_MAX - ypos); - xpos += XINT (x); - ypos += XINT (y); + wrong_type_argument (Qwindowp, window); + + xpos += check_integer_range (x, + (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM + ? (EMACS_INT) INT_MIN - xpos + : MOST_NEGATIVE_FIXNUM), + INT_MAX - xpos); + ypos += check_integer_range (y, + (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM + ? (EMACS_INT) INT_MIN - ypos + : MOST_NEGATIVE_FIXNUM), + INT_MAX - ypos); XSETFRAME (Vmenu_updating_frame, f); } @@ -1336,12 +1306,16 @@ no quit occurs and `x-popup-menu' returns nil. */) /* 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 */ + +#if defined (USE_GTK) || defined (HAVE_NS) + if (STRINGP (prompt) + && SCHARS (prompt) > 0 + && !NILP (Fget_text_property (make_fixnum (0), Qhide, prompt))) + title = Qnil; else - title = build_string ("Select"); #endif + if (!NILP (prompt)) + title = prompt; /* Make that be the pane title of the first pane. */ if (!NILP (prompt) && menu_items_n_panes >= 0) @@ -1352,7 +1326,7 @@ no quit occurs and `x-popup-menu' returns nil. */) else if (CONSP (menu) && KEYMAPP (XCAR (menu))) { /* We were given a list of keymaps. */ - EMACS_INT nmaps = XFASTINT (Flength (menu)); + ptrdiff_t nmaps = list_length (menu); Lisp_Object *maps; ptrdiff_t i; USE_SAFE_ALLOCA; @@ -1417,9 +1391,9 @@ no quit occurs and `x-popup-menu' returns nil. */) } #endif -#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */ record_unwind_protect_void (discard_menu_items); -#endif + + run_hook (Qx_pre_popup_menu_hook); /* 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 @@ -1428,13 +1402,13 @@ no quit occurs and `x-popup-menu' returns nil. */) selection = FRAME_TERMINAL (f)->menu_show_hook (f, xpos, ypos, menuflags, title, &error_name); -#ifdef HAVE_NS unbind_to (specpdl_count, Qnil); -#else - discard_menu_items (); -#endif -#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */ +#ifdef HAVE_NTGUI /* W32 specific because other terminals clear + the grab inside their `menu_show_hook's if + it's actually required (i.e. there isn't a + way to query the buttons currently held down + after XMenuActivate). */ if (FRAME_W32_P (f)) FRAME_DISPLAY_INFO (f)->grabbed = 0; #endif @@ -1443,6 +1417,55 @@ no quit occurs and `x-popup-menu' returns nil. */) return selection; } +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) +{ + init_raw_keybuf_count (); + return x_popup_menu_1 (position, menu); +} + /* If F's terminal is not capable of displaying a popup dialog, emulate it with a menu. */ @@ -1506,6 +1529,7 @@ for instance using the window manager, then this produces a quit and /* 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), Qtab_bar) || EQ (XCAR (position), Qtool_bar)))) window = selected_window; else if (CONSP (position)) @@ -1574,9 +1598,18 @@ for instance using the window manager, then this produces a quit and void syms_of_menu (void) { - staticpro (&menu_items); menu_items = Qnil; - menu_items_inuse = Qnil; + staticpro (&menu_items); + + DEFSYM (Qhide, "hide"); + DEFSYM (Qx_pre_popup_menu_hook, "x-pre-popup-menu-hook"); + + DEFVAR_LISP ("x-pre-popup-menu-hook", Vx_pre_popup_menu_hook, + doc: /* Hook run before `x-popup-menu' displays a popup menu. +It is only run before the menu is really going to be displayed. It +won't be run if `x-popup-menu' fails or returns for some other reason +(such as the keymap is invalid). */); + Vx_pre_popup_menu_hook = Qnil; defsubr (&Sx_popup_menu); defsubr (&Sx_popup_dialog); |