summaryrefslogtreecommitdiff
path: root/src/menu.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/menu.c')
-rw-r--r--src/menu.c287
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);