Commit e8886a1d authored by Richard M. Stallman's avatar Richard M. Stallman

Include puresize.h for CHECK_IMPURE.

(parse_menu_item): New function.
(menu_item_eval_property_1, menu_item_eval_property) New suroutines.
(menu_bar_one_keymap): Moved some code to menu_bar_item.
(menu_bar_item): Rewritten to use parse_menu_item.
(menu_bar_item_1): Function deleted.
(QCenable, QCvisible, QChelp, QCfilter, QCbutton, QCtoggle, QCradio):
(Qmenu_alias): New variables.
(syms_of_keyboard): Initialize them, and item_properties.
parent 2db5082f
...@@ -39,6 +39,7 @@ Boston, MA 02111-1307, USA. */ ...@@ -39,6 +39,7 @@ Boston, MA 02111-1307, USA. */
#include "syntax.h" #include "syntax.h"
#include "intervals.h" #include "intervals.h"
#include "blockinput.h" #include "blockinput.h"
#include "puresize.h"
#include <setjmp.h> #include <setjmp.h>
#include <errno.h> #include <errno.h>
...@@ -456,7 +457,12 @@ Lisp_Object Qmouse_wheel; ...@@ -456,7 +457,12 @@ Lisp_Object Qmouse_wheel;
Lisp_Object Qevent_kind; Lisp_Object Qevent_kind;
Lisp_Object Qevent_symbol_elements; Lisp_Object Qevent_symbol_elements;
/* menu item parts */
Lisp_Object Qmenu_alias;
Lisp_Object Qmenu_enable; Lisp_Object Qmenu_enable;
Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCbutton, QCtoggle, QCradio;
extern Lisp_Object Vdefine_key_rebound_commands;
extern Lisp_Object Qmenu_item;
/* An event header symbol HEAD may have a property named /* An event header symbol HEAD may have a property named
Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS); Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
...@@ -477,8 +483,6 @@ Lisp_Object Qvertical_line; ...@@ -477,8 +483,6 @@ Lisp_Object Qvertical_line;
Lisp_Object Qvertical_scroll_bar; Lisp_Object Qvertical_scroll_bar;
Lisp_Object Qmenu_bar; Lisp_Object Qmenu_bar;
extern Lisp_Object Qmenu_enable;
Lisp_Object recursive_edit_unwind (), command_loop (); Lisp_Object recursive_edit_unwind (), command_loop ();
Lisp_Object Fthis_command_keys (); Lisp_Object Fthis_command_keys ();
Lisp_Object Qextended_command_history; Lisp_Object Qextended_command_history;
...@@ -3505,7 +3509,7 @@ char *lispy_function_keys[] = ...@@ -3505,7 +3509,7 @@ char *lispy_function_keys[] =
/* /*
* VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys. * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
* Used only as parameters to GetAsyncKeyState() and GetKeyState(). * Used only as parameters to GetAsyncKeyState and GetKeyState.
* No other API or message will distinguish left and right keys this way. * No other API or message will distinguish left and right keys this way.
*/ */
/* 0xA0 .. 0xEF */ /* 0xA0 .. 0xEF */
...@@ -4114,12 +4118,12 @@ make_lispy_event (event) ...@@ -4114,12 +4118,12 @@ make_lispy_event (event)
portion_whole = Fcons (event->x, event->y); portion_whole = Fcons (event->x, event->y);
part = *scroll_bar_parts[(int) event->part]; part = *scroll_bar_parts[(int) event->part];
position = position
Fcons (window, = Fcons (window,
Fcons (Qvertical_scroll_bar, Fcons (Qvertical_scroll_bar,
Fcons (portion_whole, Fcons (portion_whole,
Fcons (make_number (event->timestamp), Fcons (make_number (event->timestamp),
Fcons (part, Qnil))))); Fcons (part, Qnil)))));
} }
/* Always treat W32 scroll bar events as clicks. */ /* Always treat W32 scroll bar events as clicks. */
...@@ -5084,7 +5088,7 @@ read_avail_input (expected) ...@@ -5084,7 +5088,7 @@ read_avail_input (expected)
#endif #endif
/* POSIX infers that processes which are not in the session leader's /* POSIX infers that processes which are not in the session leader's
process group won't get SIGHUP's at logout time. BSDI adheres to process group won't get SIGHUP's at logout time. BSDI adheres to
this part standard and returns -1 from read(0) with errno==EIO this part standard and returns -1 from read (0) with errno==EIO
when the control tty is taken away. when the control tty is taken away.
Jeffrey Honig <jch@bsdi.com> says this is generally safe. */ Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
if (nread == -1 && errno == EIO) if (nread == -1 && errno == EIO)
...@@ -5398,25 +5402,14 @@ static void ...@@ -5398,25 +5402,14 @@ static void
menu_bar_one_keymap (keymap) menu_bar_one_keymap (keymap)
Lisp_Object keymap; Lisp_Object keymap;
{ {
Lisp_Object tail, item, key, binding, item_string, table; Lisp_Object tail, item, table;
/* Loop over all keymap entries that have menu strings. */ /* Loop over all keymap entries that have menu strings. */
for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr) for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
{ {
item = XCONS (tail)->car; item = XCONS (tail)->car;
if (CONSP (item)) if (CONSP (item))
{ menu_bar_item (XCONS (item)->car, XCONS (item)->cdr);
key = XCONS (item)->car;
binding = XCONS (item)->cdr;
if (CONSP (binding))
{
item_string = XCONS (binding)->car;
if (STRINGP (item_string))
menu_bar_item (key, item_string, Fcdr (binding));
}
else if (EQ (binding, Qundefined))
menu_bar_item (key, Qnil, binding);
}
else if (VECTORP (item)) else if (VECTORP (item))
{ {
/* Loop over the char values represented in the vector. */ /* Loop over the char values represented in the vector. */
...@@ -5426,45 +5419,25 @@ menu_bar_one_keymap (keymap) ...@@ -5426,45 +5419,25 @@ menu_bar_one_keymap (keymap)
{ {
Lisp_Object character; Lisp_Object character;
XSETFASTINT (character, c); XSETFASTINT (character, c);
binding = XVECTOR (item)->contents[c]; menu_bar_item (character, XVECTOR (item)->contents[c]);
if (CONSP (binding))
{
item_string = XCONS (binding)->car;
if (STRINGP (item_string))
menu_bar_item (key, item_string, Fcdr (binding));
}
else if (EQ (binding, Qundefined))
menu_bar_item (key, Qnil, binding);
} }
} }
} }
} }
/* This is used as the handler when calling internal_condition_case_1. */
static Lisp_Object
menu_bar_item_1 (arg)
Lisp_Object arg;
{
return Qnil;
}
/* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF. /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
If there's already an item for KEY, add this DEF to it. */ If there's already an item for KEY, add this DEF to it. */
Lisp_Object item_properties;
static void static void
menu_bar_item (key, item_string, def) menu_bar_item (key, item)
Lisp_Object key, item_string, def; Lisp_Object key, item;
{ {
Lisp_Object tem; struct gcpro gcpro1;
Lisp_Object enabled;
int i; int i;
/* Skip menu-bar equiv keys data. */ if (EQ (item, Qundefined))
if (CONSP (def) && CONSP (XCONS (def)->car))
def = XCONS (def)->cdr;
if (EQ (def, Qundefined))
{ {
/* If a map has an explicit `undefined' as definition, /* If a map has an explicit `undefined' as definition,
discard any previously made menu bar item. */ discard any previously made menu bar item. */
...@@ -5485,25 +5458,14 @@ menu_bar_item (key, item_string, def) ...@@ -5485,25 +5458,14 @@ menu_bar_item (key, item_string, def)
return; return;
} }
/* See if this entry is enabled. */ GCPRO1 (key); /* Is this necessary? */
enabled = Qt; i = parse_menu_item (item, 0, 1);
UNGCPRO;
if (SYMBOLP (def)) if (!i)
{
/* No property, or nil, means enable.
Otherwise, enable if value is not nil. */
tem = Fget (def, Qmenu_enable);
if (!NILP (tem))
/* (condition-case nil (eval tem)
(error nil)) */
enabled = internal_condition_case_1 (Feval, tem, Qerror,
menu_bar_item_1);
}
/* Ignore this item if it's not enabled. */
if (NILP (enabled))
return; return;
item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
/* Find any existing item for this KEY. */ /* Find any existing item for this KEY. */
for (i = 0; i < menu_bar_items_index; i += 4) for (i = 0; i < menu_bar_items_index; i += 4)
if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i])) if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
...@@ -5522,21 +5484,341 @@ menu_bar_item (key, item_string, def) ...@@ -5522,21 +5484,341 @@ menu_bar_item (key, item_string, def)
XVECTOR (tem)->contents, i * sizeof (Lisp_Object)); XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
menu_bar_items_vector = tem; menu_bar_items_vector = tem;
} }
/* Add this item. */ /* Add this item. */
XVECTOR (menu_bar_items_vector)->contents[i++] = key; XVECTOR (menu_bar_items_vector)->contents[i++] = key;
XVECTOR (menu_bar_items_vector)->contents[i++] = item_string; XVECTOR (menu_bar_items_vector)->contents[i++]
XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (def, Qnil); = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0); XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
menu_bar_items_index = i; menu_bar_items_index = i;
} }
/* We did find an item for this KEY. Add DEF to its list of maps. */ /* We did find an item for this KEY. Add ITEM to its list of maps. */
else else
{ {
Lisp_Object old; Lisp_Object old;
old = XVECTOR (menu_bar_items_vector)->contents[i + 2]; old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (def, old); XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
} }
} }
/* This is used as the handler when calling menu_item_eval_property. */
static Lisp_Object
menu_item_eval_property_1 (arg)
Lisp_Object arg;
{
/* If we got a quit from within the menu computation,
quit all the way out of it. This takes care of C-] in the debugger. */
if (CONSP (arg) && EQ (XCONS (arg)->car, Qquit))
Fsignal (Qquit, Qnil);
return Qnil;
}
/* Evaluate an expression and return the result (or nil if something
went wrong). Used to evaluate dynamic parts of menu items. */
static Lisp_Object
menu_item_eval_property (sexpr)
Lisp_Object sexpr;
{
Lisp_Object val;
val = internal_condition_case_1 (Feval, sexpr, Qerror,
menu_item_eval_property_1);
return val;
}
/* This function parses a menu item and leaves the result in the
vector item_properties.
ITEM is a key binding, a possible menu item.
If NOTREAL is nonzero, only check for equivalent key bindings, don't
evaluate dynamic expressions in the menu item.
INMENUBAR is true when this is considered for an entry in a menu bar
top level.
parse_menu_item returns true if the item is a menu item and false
otherwise. */
int
parse_menu_item (item, notreal, inmenubar)
Lisp_Object item;
int notreal, inmenubar;
{
Lisp_Object def, tem;
Lisp_Object type = Qnil;
Lisp_Object cachelist = Qnil;
Lisp_Object filter = Qnil;
Lisp_Object item_string, start;
int i;
struct gcpro gcpro1, gcpro2, gcpro3;
#define RET0 \
if (1) \
{ \
UNGCPRO; \
return 0; \
} \
else
if (!CONSP (item))
return 0;
GCPRO3 (item, notreal, inmenubar);
/* Create item_properties vector if necessary. */
if (NILP (item_properties))
item_properties
= Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
/* Initialize optional entries. */
for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
XVECTOR (item_properties)->contents[i] = Qnil;
XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = Qt;
/* Save the item here to protect it from GC. */
XVECTOR (item_properties)->contents[ITEM_PROPERTY_ITEM] = item;
item_string = XCONS (item)->car;
start = item;
item = XCONS (item)->cdr;
if (STRINGP (item_string))
{
/* Old format menu item. */
XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string;
/* Maybe help string. */
if (CONSP (item) && STRINGP (XCONS (item)->car))
{
XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]
= XCONS (item)->car;
start = item;
item = XCONS (item)->cdr;
}
/* Maybee key binding cache. */
if (CONSP (item) && CONSP (XCONS (item)->car)
&& (NILP (XCONS (XCONS (item)->car)->car)
|| VECTORP (XCONS (XCONS (item)->car)->car)))
{
cachelist = XCONS (item)->car;
item = XCONS (item)->cdr;
}
/* This is the real definition--the function to run. */
XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = item;
/* Get enable property, if any. */
if (SYMBOLP (item))
{
tem = Fget (item, Qmenu_enable);
if (!NILP (tem))
XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem;
}
}
else if (EQ (item_string, Qmenu_item) && CONSP (item))
{
/* New format menu item. */
XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME]
= XCONS (item)->car;
start = XCONS (item)->cdr;
if (CONSP (start))
{
/* We have a real binding. */
XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]
= XCONS (start)->car;
item = XCONS (start)->cdr;
/* Is there a cache list with key equivalences. */
if (CONSP (item) && CONSP (XCONS (item)->car))
{
cachelist = XCONS (item)->car;
item = XCONS (item)->cdr;
}
/* Parse properties. */
while (CONSP (item) && CONSP (XCONS (item)->cdr))
{
tem = XCONS (item)->car;
item = XCONS (item)->cdr;
if (EQ (tem, QCenable))
XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE]
= XCONS (item)->car;
else if (EQ (tem, QCvisible) && !notreal)
{
/* If got a visible property and that evaluates to nil
then ignore this item. */
tem = menu_item_eval_property (XCONS (item)->car);
if (NILP (tem))
RET0;
}
else if (EQ (tem, QChelp))
XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]
= XCONS (item)->car;
else if (EQ (tem, QCfilter))
filter = XCONS (item)->car;
else if (EQ (tem, QCbutton) && CONSP (XCONS (item)->car))
{
tem = XCONS (item)->car;
type = XCONS (tem)->car;
if (EQ (type, QCtoggle) || EQ (type, QCradio))
{
XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]
= XCONS (tem)->cdr;
XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE]
= type;
}
}
item = XCONS (item)->cdr;
}
}
else if (inmenubar || !NILP (start))
RET0;
}
else
RET0;
/* If item string is not a string, evaluate it to get string.
If we don't get a string, skip this item. */
item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
if (!(STRINGP (item_string) || notreal))
{
item_string = menu_item_eval_property (item_string);
if (!STRINGP (item_string))
RET0;
XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string;
}
/* If got a filter apply it on definition. */
def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
if (!NILP (filter))
{
def = menu_item_eval_property (Fcons (filter, Fcons (def, Qnil)));
XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = def;
}
/* If we got no definition, this item is just unselectable text which
is ok when in a submenu and if there is an item string. */
item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
if (NILP (def))
{
UNGCPRO;
return (!inmenubar && STRINGP (item_string) ? 1 : 0);
}
/* Enable or disable selection of item. */
tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
if (!EQ (tem, Qt))
{
if (notreal)
tem = Qt;
else
tem = menu_item_eval_property (tem);
if (inmenubar && NILP (tem))
RET0; /* Ignore disabled items in menu bar. */
XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem;
}
/* See if this is a separate pane or a submenu. */
tem = get_keymap_1 (def, 0, 1);
if (!NILP (tem))
{
XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP] = tem;
XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = tem;
UNGCPRO;
return 1;
}
else if (inmenubar)
RET0; /* Entries in menu bar must be submenus. */
/* This is a command. See if there is an equivalent key binding. */
if (NILP (cachelist))
{
/* We have to create a cachelist. */
CHECK_IMPURE (start);
XCONS (start)->cdr = Fcons (Fcons (Qnil, Qnil), XCONS (start)->cdr);
cachelist = XCONS (XCONS (start)->cdr)->car;
/* We have not checked this before so check it now. */
tem = def;
}
else if (VECTORP (XCONS (cachelist)->car)) /* Saved key */
{
tem = Fkey_binding (XCONS (cachelist)->car, Qnil);
if (EQ (tem, def)
/* If the command is an alias for another
(such as easymenu.el and lmenu.el set it up),
check if the original command matches the cached command. */
|| (SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function)))
tem = Qnil; /* Don't need to recompute key binding. */
else
tem = def;
}
/* If something had no key binding before, don't recheck it
because that is too slow--except if we have a list of rebound
commands in Vdefine_key_rebound_commands, do recheck any command
that appears in that list. */
else if (!NILP (XCONS (cachelist)->car))
tem = def; /* Should signal an error here. */
else if (
/* Should we check everything when precomputing key bindings? */
/* notreal || */
CONSP (Vdefine_key_rebound_commands)
&& !NILP (Fmemq (def, Vdefine_key_rebound_commands)))
tem = def;
else
tem = Qnil;
if (!NILP (tem))
{
/* Recompute equivalent key binding.
If the command is an alias for another
(such as easymenu.el and lmenu.el set it up),
see if the original command name has equivalent keys.
Otherwise look up the specified command itself.
We don't try both, because that makes easymenu menus slow. */
if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
&& ! NILP (Fget (def, Qmenu_alias)))
tem = XSYMBOL (def)->function;
tem = Fwhere_is_internal (tem, Qnil, Qt, Qnil);
XCONS (cachelist)->car = tem;
XCONS (cachelist)->cdr
= (NILP (tem) ? Qnil
:
concat2 (build_string (" ("),
concat2 (Fkey_description (tem), build_string (")"))));
}
/* If we only want to precompute equivalent key bindings, stop here. */
if (notreal)
{
UNGCPRO;
return 1;
}
/* If we have an equivalent key binding, use that. */
XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]
= XCONS (cachelist)->cdr;
/* Include this when menu help is implemented.
tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
if (!(NILP (tem) || STRINGP (tem)))
{
tem = menu_item_eval_property (tem);
if (!STRINGP (tem))
tem = Qnil;
XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
}
*/
/* Handle radio buttons or toggle boxes. */
tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
if (!NILP (tem))
XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]
= menu_item_eval_property (tem);
UNGCPRO;
return 1;
}
/* Read a character using menus based on maps in the array MAPS. /* Read a character using menus based on maps in the array MAPS.
NMAPS is the length of MAPS. Return nil if there are no menus in the maps. NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
...@@ -8124,6 +8406,9 @@ struct event_head head_table[] = { ...@@ -8124,6 +8406,9 @@ struct event_head head_table[] = {
syms_of_keyboard () syms_of_keyboard ()
{ {
staticpro (&item_properties);
item_properties = Qnil;
Qtimer_event_handler = intern ("timer-event-handler"); Qtimer_event_handler = intern ("timer-event-handler");
staticpro (&Qtimer_event_handler); staticpro (&Qtimer_event_handler);
...@@ -8171,6 +8456,20 @@ syms_of_keyboard () ...@@ -8171,6 +8456,20 @@ syms_of_keyboard ()
Qmenu_enable = intern ("menu-enable"); Qmenu_enable = intern ("menu-enable");
staticpro (&Qmenu_enable); staticpro (&Qmenu_enable);
Qmenu_alias = intern ("menu-alias");
staticpro (&Qmenu_alias);
QCenable = intern (":enable");
staticpro (&QCenable);
QCvisible = intern (":visible");
staticpro (&QCvisible);
QCfilter = intern (":filter");
staticpro (&QCfilter);
QCbutton = intern (":button");
staticpro (&QCbutton);
QCtoggle = intern (":toggle");
staticpro (&QCtoggle);
QCradio = intern (":radio");
staticpro (&QCradio);
Qmode_line = intern ("mode-line"); Qmode_line = intern ("mode-line");
staticpro (&Qmode_line); staticpro (&Qmode_line);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment