#include "window.h"
#include "keyboard.h"
#include "blockinput.h"
-#include "puresize.h"
#include "buffer.h"
#ifdef MSDOS
Lisp_Object Qdebug_on_next_call;
-Lisp_Object Qmenu_alias;
-
-extern Lisp_Object Qmenu_enable;
extern Lisp_Object Qmenu_bar;
extern Lisp_Object Qmouse_click, Qevent_kind;
-extern Lisp_Object Vdefine_key_rebound_commands;
+extern Lisp_Object QCtoggle, QCradio;
extern Lisp_Object Voverriding_local_map;
extern Lisp_Object Voverriding_local_map_menu_flag;
static Lisp_Object xmenu_show ();
static void keymap_panes ();
static void single_keymap_panes ();
+static void single_menu_item ();
static void list_of_panes ();
static void list_of_items ();
\f
XVECTOR (menu_items)->contents[menu_items_used++] = def;
}
\f
-/* Figure out the current keyboard equivalent of a menu item ITEM1.
- The item string for menu display should be ITEM_STRING.
- Store the equivalent keyboard key sequence's
- textual description into *DESCRIP_PTR.
- Also cache them in the item itself.
- Return the real definition to execute. */
-
-static Lisp_Object
-menu_item_equiv_key (item_string, item1, descrip_ptr)
- Lisp_Object item_string;
- Lisp_Object item1;
- Lisp_Object *descrip_ptr;
-{
- /* This is the real definition--the function to run. */
- Lisp_Object def;
- /* This is the sublist that records cached equiv key data
- so we can save time. */
- Lisp_Object cachelist;
- /* These are the saved equivalent keyboard key sequence
- and its key-description. */
- Lisp_Object savedkey, descrip;
- Lisp_Object def1;
- int changed = 0;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- /* If a help string follows the item string, skip it. */
- if (CONSP (XCONS (item1)->cdr)
- && STRINGP (XCONS (XCONS (item1)->cdr)->car))
- item1 = XCONS (item1)->cdr;
-
- def = Fcdr (item1);
-
- /* Get out the saved equivalent-keyboard-key info. */
- cachelist = savedkey = descrip = Qnil;
- if (CONSP (def) && CONSP (XCONS (def)->car)
- && (NILP (XCONS (XCONS (def)->car)->car)
- || VECTORP (XCONS (XCONS (def)->car)->car)))
- {
- cachelist = XCONS (def)->car;
- def = XCONS (def)->cdr;
- savedkey = XCONS (cachelist)->car;
- descrip = XCONS (cachelist)->cdr;
- }
-
- GCPRO4 (def, def1, savedkey, descrip);
-
- /* Is it still valid? */
- def1 = Qnil;
- if (!NILP (savedkey))
- def1 = Fkey_binding (savedkey, Qnil);
- /* If not, update it. */
- if (! EQ (def1, 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) && SYMBOLP (XSYMBOL (def)->function)
- && EQ (def1, XSYMBOL (def)->function))
- /* 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. */
- && (NILP (cachelist) || !NILP (savedkey)
- || (! EQ (Qt, Vdefine_key_rebound_commands)
- && !NILP (Fmemq (def, Vdefine_key_rebound_commands)))))
- {
- changed = 1;
- descrip = Qnil;
- /* 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. */
- if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
- && ! NILP (Fget (def, Qmenu_alias)))
- savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
- Qnil, Qt, Qnil);
- else
- /* Otherwise look up the specified command itself.
- We don't try both, because that makes easymenu menus slow. */
- savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
-
- if (!NILP (savedkey))
- {
- descrip = Fkey_description (savedkey);
- descrip = concat2 (make_string (" (", 3), descrip);
- descrip = concat2 (descrip, make_string (")", 1));
- }
- }
-
- /* Cache the data we just got in a sublist of the menu binding. */
- if (NILP (cachelist))
- {
- CHECK_IMPURE (item1);
- XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
- }
- else if (changed)
- {
- XCONS (cachelist)->car = savedkey;
- XCONS (cachelist)->cdr = descrip;
- }
-
- UNGCPRO;
- *descrip_ptr = descrip;
- return def;
-}
-
-/* This is used as the handler when calling internal_condition_case_1. */
-
-static Lisp_Object
-menu_item_enabled_p_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;
-}
-
-/* Return non-nil if the command DEF is enabled when used as a menu item.
- This is based on looking for a menu-enable property.
- If NOTREAL is set, don't bother really computing this. */
-
-static Lisp_Object
-menu_item_enabled_p (def, notreal)
- Lisp_Object def;
- int notreal;
-{
- Lisp_Object enabled, tem;
-
- enabled = Qt;
- if (notreal)
- return enabled;
- if (SYMBOLP (def))
- {
- /* 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_item_enabled_p_1);
- }
- return enabled;
-}
-\f
/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
and generate menu panes for them in menu_items.
If NOTREAL is nonzero,
It handles one keymap, KEYMAP.
The other arguments are passed along
or point to local variables of the previous function.
- If NOTREAL is nonzero,
- don't bother really computing whether an item is enabled.
+ 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. */
int notreal;
int maxdepth;
{
- Lisp_Object pending_maps;
- Lisp_Object tail, item, item1, item_string, table;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ Lisp_Object pending_maps = Qnil;
+ Lisp_Object tail, item;
+ struct gcpro gcpro1, gcpro2;
+ int notbuttons = 0;
if (maxdepth <= 0)
return;
- pending_maps = Qnil;
-
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. */
+ notbuttons = menu_items_used;
+#endif
+
for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
{
- /* Look at each key binding, and if it has a menu string,
- make a menu item from it. */
+ GCPRO2 (keymap, pending_maps);
+ /* Look at each key binding, and if it is a menu item add it
+ to this menu. */
item = XCONS (tail)->car;
if (CONSP (item))
- {
- item1 = XCONS (item)->cdr;
- if (CONSP (item1))
- {
- item_string = XCONS (item1)->car;
- if (STRINGP (item_string))
- {
- /* This is the real definition--the function to run. */
- Lisp_Object def;
- /* These are the saved equivalent keyboard key sequence
- and its key-description. */
- Lisp_Object descrip;
- Lisp_Object tem, enabled;
-
- /* GCPRO because ...enabled_p will call eval
- and ..._equiv_key may autoload something.
- Protecting KEYMAP preserves everything we use;
- aside from that, must protect whatever might be
- a string. Since there's no GCPRO5, we refetch
- item_string instead of protecting it. */
- descrip = def = Qnil;
- GCPRO4 (keymap, pending_maps, def, descrip);
-
- def = menu_item_equiv_key (item_string, item1, &descrip);
- enabled = menu_item_enabled_p (def, notreal);
-
- UNGCPRO;
-
- item_string = XCONS (item1)->car;
-
- tem = Fkeymapp (def);
- if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
- pending_maps = Fcons (Fcons (def, Fcons (item_string, XCONS (item)->car)),
- pending_maps);
- else
- {
- Lisp_Object submap;
- GCPRO4 (keymap, pending_maps, descrip, item_string);
- submap = get_keymap_1 (def, 0, 1);
- UNGCPRO;
-#ifndef USE_X_TOOLKIT
- /* Indicate visually that this is a submenu. */
- if (!NILP (submap))
- item_string = concat2 (item_string,
- build_string (" >"));
-#endif
- /* If definition is nil, pass nil as the key. */
- push_menu_item (item_string, enabled,
- XCONS (item)->car, def,
- descrip);
-#ifdef USE_X_TOOLKIT
- /* Display a submenu using the toolkit. */
- if (! NILP (submap))
- {
- push_submenu_start ();
- single_keymap_panes (submap, Qnil,
- XCONS (item)->car, notreal,
- maxdepth - 1);
- push_submenu_end ();
- }
-#endif
- }
- }
- }
- }
+ single_menu_item (XCONS (item)->car, XCONS (item)->cdr,
+ &pending_maps, notreal, maxdepth, ¬buttons);
else if (VECTORP (item))
{
/* Loop over the char values represented in the vector. */
{
Lisp_Object character;
XSETFASTINT (character, c);
- item1 = XVECTOR (item)->contents[c];
- if (CONSP (item1))
- {
- item_string = XCONS (item1)->car;
- if (STRINGP (item_string))
- {
- Lisp_Object def;
-
- /* These are the saved equivalent keyboard key sequence
- and its key-description. */
- Lisp_Object descrip;
- Lisp_Object tem, enabled;
-
- /* GCPRO because ...enabled_p will call eval
- and ..._equiv_key may autoload something.
- Protecting KEYMAP preserves everything we use;
- aside from that, must protect whatever might be
- a string. Since there's no GCPRO5, we refetch
- item_string instead of protecting it. */
- GCPRO4 (keymap, pending_maps, def, descrip);
- descrip = def = Qnil;
-
- def = menu_item_equiv_key (item_string, item1, &descrip);
- enabled = menu_item_enabled_p (def, notreal);
-
- UNGCPRO;
-
- item_string = XCONS (item1)->car;
-
- tem = Fkeymapp (def);
- if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
- pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
- pending_maps);
- else
- {
- Lisp_Object submap;
- GCPRO4 (keymap, pending_maps, descrip, item_string);
- submap = get_keymap_1 (def, 0, 1);
- UNGCPRO;
-#ifndef USE_X_TOOLKIT
- if (!NILP (submap))
- item_string = concat2 (item_string,
- build_string (" >"));
-#endif
- /* If definition is nil, pass nil as the key. */
- push_menu_item (item_string, enabled, character,
- def, descrip);
-#ifdef USE_X_TOOLKIT
- if (! NILP (submap))
- {
- push_submenu_start ();
- single_keymap_panes (submap, Qnil,
- character, notreal,
- maxdepth - 1);
- push_submenu_end ();
- }
-#endif
- }
- }
- }
+ single_menu_item (character, XVECTOR (item)->contents[c],
+ &pending_maps, notreal, maxdepth, ¬buttons);
}
}
+ UNGCPRO;
}
/* Process now any submenus which want to be panes at this level. */
}
}
\f
+/* This is a subroutine of single_keymap_panes that handles one
+ keymap entry.
+ KEY is a key in a keymap and ITEM is its binding.
+ PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
+ separate panes.
+ 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.
+ NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
+ buttons. It points to variable notbuttons in single_keymap_panes,
+ which keeps track of if we have seen a button in this menu or not. */
+
+static void
+single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth,
+ notbuttons_ptr)
+ Lisp_Object key, item;
+ Lisp_Object *pending_maps_ptr;
+ int maxdepth, notreal;
+ int *notbuttons_ptr;
+{
+ Lisp_Object def, map, item_string, enabled;
+ struct gcpro gcpro1, gcpro2;
+ int res;
+
+ /* Parse the menu item and leave the result in item_properties. */
+ GCPRO2 (key, item);
+ res = parse_menu_item (item, notreal, 0);
+ UNGCPRO;
+ if (!res)
+ return; /* Not a menu item. */
+
+ map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
+
+ if (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, maxdepth - 1);
+ return;
+ }
+
+ enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
+ item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
+
+ if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
+ {
+ if (!NILP (enabled))
+ /* An enabled separate pane. Remember this to handle it later. */
+ *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
+ *pending_maps_ptr);
+ return;
+ }
+
+#ifndef HAVE_BOXES
+ /* Simulate radio buttons and toggle boxes by putting a prefix in
+ front of them. */
+ {
+ Lisp_Object prefix = Qnil;
+ Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
+ if (!NILP (type))
+ {
+ Lisp_Object selected
+ = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
+
+ if (*notbuttons_ptr)
+ /* The first button. Line up previous items in this menu. */
+ {
+ int index = *notbuttons_ptr; /* Index for first item this menu. */
+ int submenu = 0;
+ Lisp_Object tem;
+ while (index < menu_items_used)
+ {
+ tem
+ = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
+ if (NILP (tem))
+ {
+ index++;
+ submenu++; /* Skip sub menu. */
+ }
+ else if (EQ (tem, Qlambda))
+ {
+ index++;
+ submenu--; /* End sub menu. */
+ }
+ else if (EQ (tem, Qt))
+ index += 3; /* Skip new pane marker. */
+ else if (EQ (tem, Qquote))
+ index++; /* Skip a left, right divider. */
+ else
+ {
+ if (!submenu && XSTRING (tem)->data[0] != '\0'
+ && XSTRING (tem)->data[0] != '-')
+ XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]
+ = concat2 (build_string (" "), tem);
+ index += MENU_ITEMS_ITEM_LENGTH;
+ }
+ }
+ *notbuttons_ptr = 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 (!*notbuttons_ptr && XSTRING (item_string)->data[0] != '\0'
+ && XSTRING (item_string)->data[0] != '-')
+ prefix = build_string (" ");
+
+ if (!NILP (prefix))
+ item_string = concat2 (prefix, item_string);
+ }
+#endif /* not HAVE_BOXES */
+
+#ifndef USE_X_TOOLKIT
+ if (!NILP(map))
+ /* Indicate visually that this is a submenu. */
+ item_string = concat2 (item_string, build_string (" >"));
+#endif
+
+ push_menu_item (item_string, enabled, key,
+ XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
+ XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]);
+
+#ifdef USE_X_TOOLKIT
+ /* Display a submenu using the toolkit. */
+ if (! (NILP (map) || NILP (enabled)))
+ {
+ push_submenu_start ();
+ single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
+ push_submenu_end ();
+ }
+#endif
+}
+\f
/* Push all the panes and items of a menu described by the
alist-of-alists MENU.
This handles old-fashioned calls to x-popup-menu. */
staticpro (&menu_items);
menu_items = Qnil;
- Qmenu_alias = intern ("menu-alias");
- staticpro (&Qmenu_alias);
-
Qdebug_on_next_call = intern ("debug-on-next-call");
staticpro (&Qdebug_on_next_call);
projects / emacs.git / commitdiff