X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d3b8a776aca21110c42515172b8a8e9e41d97070..37a99821999c7198aeff9bb68b159c3e5fcf1b60:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index a80b14d538..2665941022 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,5 +1,5 @@ /* Manipulation of keymaps - Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc. + Copyright (C) 1985, 86,87,88,93,94,95,98,99 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -30,8 +30,10 @@ Boston, MA 02111-1307, USA. */ #include "termhooks.h" #include "blockinput.h" #include "puresize.h" +#include "intervals.h" #define min(a, b) ((a) < (b) ? (a) : (b)) +#define KEYMAPP(m) (!NILP (Fkeymapp (m))) /* The number of elements in keymap vectors. */ #define DENSE_TABLE_SIZE (0200) @@ -89,7 +91,7 @@ Lisp_Object Vkey_translation_map; when Emacs starts up. t means don't record anything here. */ Lisp_Object Vdefine_key_rebound_commands; -Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii; +Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item; /* A char with the CHAR_META bit set in a vector or the 0200 bit set in a string key sequence is equivalent to prefixing with this @@ -98,17 +100,22 @@ extern Lisp_Object meta_prefix_char; extern Lisp_Object Voverriding_local_map; -static Lisp_Object define_as_prefix (); -static Lisp_Object describe_buffer_bindings (); -static void describe_command (), describe_translation (); -static void describe_map (); -Lisp_Object Fcopy_keymap (); +static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); +static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); + +static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object describe_buffer_bindings P_ ((Lisp_Object)); +static void describe_command P_ ((Lisp_Object)); +static void describe_translation P_ ((Lisp_Object)); +static void describe_map P_ ((Lisp_Object, Lisp_Object, + void (*) P_ ((Lisp_Object)), + int, Lisp_Object, Lisp_Object*, int)); /* Keymap object support - constructors and predicates. */ DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0, - "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\ -VECTOR is a vector which holds the bindings for the ASCII\n\ + "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\ +CHARTABLE is a char-table that holds the bindings for the ASCII\n\ characters. ALIST is an assoc-list which holds bindings for function keys,\n\ mouse events, and any other things that appear in the input stream.\n\ All entries in it are initially nil, meaning \"command undefined\".\n\n\ @@ -195,6 +202,7 @@ is also allowed as an element.") (object) Lisp_Object object; { + /* FIXME: Maybe this should return t for autoloaded keymaps? -sm */ return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt); } @@ -212,7 +220,10 @@ is also allowed as an element.") Functions like Faccessible_keymaps which scan entire keymap trees shouldn't load every autoloaded keymap. I'm not sure about this, but it seems to me that only read_key_sequence, Flookup_key, and - Fdefine_key should cause keymaps to be autoloaded. */ + Fdefine_key should cause keymaps to be autoloaded. + + This function can GC when AUTOLOAD is non-zero, because it calls + do_autoload which can GC. */ Lisp_Object get_keymap_1 (object, error, autoload) @@ -222,16 +233,23 @@ get_keymap_1 (object, error, autoload) Lisp_Object tem; autoload_retry: - tem = indirect_function (object); - if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap)) - return tem; + if (NILP (object)) + goto end; + if (CONSP (object) && EQ (XCAR (object), Qkeymap)) + return object; + else + { + tem = indirect_function (object); + if (CONSP (tem) && EQ (XCAR (tem), Qkeymap)) + return tem; + } /* Should we do an autoload? Autoload forms for keymaps have Qkeymap as their fifth element. */ if (autoload && SYMBOLP (object) && CONSP (tem) - && EQ (XCONS (tem)->car, Qautoload)) + && EQ (XCAR (tem), Qautoload)) { Lisp_Object tail; @@ -248,6 +266,7 @@ get_keymap_1 (object, error, autoload) } } + end: if (error) wrong_type_argument (Qkeymapp, object); else @@ -277,17 +296,18 @@ DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0, keymap = get_keymap_1 (keymap, 1, 1); /* Skip past the initial element `keymap'. */ - list = XCONS (keymap)->cdr; - for (; CONSP (list); list = XCONS (list)->cdr) + list = XCDR (keymap); + for (; CONSP (list); list = XCDR (list)) { /* See if there is another `keymap'. */ - if (EQ (Qkeymap, XCONS (list)->car)) + if (KEYMAPP (list)) return list; } return Qnil; } + /* Set the parent keymap of MAP to PARENT. */ DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0, @@ -297,27 +317,41 @@ PARENT should be nil or another keymap.") Lisp_Object keymap, parent; { Lisp_Object list, prev; + struct gcpro gcpro1; int i; keymap = get_keymap_1 (keymap, 1, 1); + GCPRO1 (keymap); + if (!NILP (parent)) - parent = get_keymap_1 (parent, 1, 1); + { + Lisp_Object k; + + parent = get_keymap_1 (parent, 1, 1); + + /* Check for cycles. */ + k = parent; + while (KEYMAPP (k) && !EQ (keymap, k)) + k = Fkeymap_parent (k); + if (EQ (keymap, k)) + error ("Cyclic keymap inheritance"); + } /* Skip past the initial element `keymap'. */ prev = keymap; while (1) { - list = XCONS (prev)->cdr; + list = XCDR (prev); /* If there is a parent keymap here, replace it. If we came to the end, add the parent in PREV. */ - if (! CONSP (list) || EQ (Qkeymap, XCONS (list)->car)) + if (! CONSP (list) || KEYMAPP (list)) { /* If we already have the right parent, return now so that we avoid the loops below. */ - if (EQ (XCONS (prev)->cdr, parent)) - return parent; + if (EQ (XCDR (prev), parent)) + RETURN_UNGCPRO (parent); - XCONS (prev)->cdr = parent; + XCDR (prev) = parent; break; } prev = list; @@ -325,41 +359,41 @@ PARENT should be nil or another keymap.") /* Scan through for submaps, and set their parents too. */ - for (list = XCONS (keymap)->cdr; CONSP (list); list = XCONS (list)->cdr) + for (list = XCDR (keymap); CONSP (list); list = XCDR (list)) { /* Stop the scan when we come to the parent. */ - if (EQ (XCONS (list)->car, Qkeymap)) + if (EQ (XCAR (list), Qkeymap)) break; /* If this element holds a prefix map, deal with it. */ - if (CONSP (XCONS (list)->car) - && CONSP (XCONS (XCONS (list)->car)->cdr)) - fix_submap_inheritance (keymap, XCONS (XCONS (list)->car)->car, - XCONS (XCONS (list)->car)->cdr); - - if (VECTORP (XCONS (list)->car)) - for (i = 0; i < XVECTOR (XCONS (list)->car)->size; i++) - if (CONSP (XVECTOR (XCONS (list)->car)->contents[i])) + if (CONSP (XCAR (list)) + && CONSP (XCDR (XCAR (list)))) + fix_submap_inheritance (keymap, XCAR (XCAR (list)), + XCDR (XCAR (list))); + + if (VECTORP (XCAR (list))) + for (i = 0; i < XVECTOR (XCAR (list))->size; i++) + if (CONSP (XVECTOR (XCAR (list))->contents[i])) fix_submap_inheritance (keymap, make_number (i), - XVECTOR (XCONS (list)->car)->contents[i]); + XVECTOR (XCAR (list))->contents[i]); - if (CHAR_TABLE_P (XCONS (list)->car)) + if (CHAR_TABLE_P (XCAR (list))) { Lisp_Object indices[3]; - map_char_table (fix_submap_inheritance, Qnil, XCONS (list)->car, + map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap, 0, indices); } } - return parent; + RETURN_UNGCPRO (parent); } /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition. if EVENT is also a prefix in MAP's parent, make sure that SUBMAP inherits that definition as its own parent. */ -void +static void fix_submap_inheritance (map, event, submap) Lisp_Object map, event, submap; { @@ -368,28 +402,40 @@ fix_submap_inheritance (map, event, submap) /* SUBMAP is a cons that we found as a key binding. Discard the other things found in a menu key binding. */ - if (CONSP (submap) - && STRINGP (XCONS (submap)->car)) - { - submap = XCONS (submap)->cdr; - /* Also remove a menu help string, if any, - following the menu item name. */ - if (CONSP (submap) && STRINGP (XCONS (submap)->car)) - submap = XCONS (submap)->cdr; - /* Also remove the sublist that caches key equivalences, if any. */ - if (CONSP (submap) - && CONSP (XCONS (submap)->car)) + if (CONSP (submap)) + { + /* May be an old format menu item */ + if (STRINGP (XCAR (submap))) + { + submap = XCDR (submap); + /* Also remove a menu help string, if any, + following the menu item name. */ + if (CONSP (submap) && STRINGP (XCAR (submap))) + submap = XCDR (submap); + /* Also remove the sublist that caches key equivalences, if any. */ + if (CONSP (submap) + && CONSP (XCAR (submap))) + { + Lisp_Object carcar; + carcar = XCAR (XCAR (submap)); + if (NILP (carcar) || VECTORP (carcar)) + submap = XCDR (submap); + } + } + + /* Or a new format menu item */ + else if (EQ (XCAR (submap), Qmenu_item) + && CONSP (XCDR (submap))) { - Lisp_Object carcar; - carcar = XCONS (XCONS (submap)->car)->car; - if (NILP (carcar) || VECTORP (carcar)) - submap = XCONS (submap)->cdr; + submap = XCDR (XCDR (submap)); + if (CONSP (submap)) + submap = XCAR (submap); } } /* If it isn't a keymap now, there's no work to do. */ if (! CONSP (submap) - || ! EQ (XCONS (submap)->car, Qkeymap)) + || ! EQ (XCAR (submap), Qkeymap)) return; map_parent = Fkeymap_parent (map); @@ -400,11 +446,27 @@ fix_submap_inheritance (map, event, submap) /* If MAP's parent has something other than a keymap, our own submap shadows it completely, so use nil as SUBMAP's parent. */ - if (! (CONSP (parent_entry) && EQ (XCONS (parent_entry)->car, Qkeymap))) + if (! (CONSP (parent_entry) && EQ (XCAR (parent_entry), Qkeymap))) parent_entry = Qnil; if (! EQ (parent_entry, submap)) - Fset_keymap_parent (submap, parent_entry); + { + Lisp_Object submap_parent; + submap_parent = submap; + while (1) + { + Lisp_Object tem; + tem = Fkeymap_parent (submap_parent); + if (EQ (tem, parent_entry)) + return; + if (CONSP (tem) + && EQ (XCAR (tem), Qkeymap)) + submap_parent = tem; + else + break; + } + Fset_keymap_parent (submap_parent, parent_entry); + } } /* Look up IDX in MAP. IDX may be any sort of event. @@ -448,11 +510,11 @@ access_keymap (map, idx, t_ok, noinherit) Lisp_Object t_binding; t_binding = Qnil; - for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = map; CONSP (tail); tail = XCDR (tail)) { Lisp_Object binding; - binding = XCONS (tail)->car; + binding = XCAR (tail); if (SYMBOLP (binding)) { /* If NOINHERIT, stop finding prefix definitions @@ -462,24 +524,24 @@ access_keymap (map, idx, t_ok, noinherit) } else if (CONSP (binding)) { - if (EQ (XCONS (binding)->car, idx)) + if (EQ (XCAR (binding), idx)) { - val = XCONS (binding)->cdr; - if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) + val = XCDR (binding); + if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap)) return Qnil; if (CONSP (val)) fix_submap_inheritance (map, idx, val); return val; } - if (t_ok && EQ (XCONS (binding)->car, Qt)) - t_binding = XCONS (binding)->cdr; + if (t_ok && EQ (XCAR (binding), Qt)) + t_binding = XCDR (binding); } else if (VECTORP (binding)) { if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size) { val = XVECTOR (binding)->contents[XFASTINT (idx)]; - if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) + if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap)) return Qnil; if (CONSP (val)) fix_submap_inheritance (map, idx, val); @@ -497,7 +559,7 @@ access_keymap (map, idx, t_ok, noinherit) | CHAR_SHIFT | CHAR_CTL | CHAR_META))) { val = Faref (binding, idx); - if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) + if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap)) return Qnil; if (CONSP (val)) fix_submap_inheritance (map, idx, val); @@ -531,68 +593,112 @@ get_keyelt (object, autoload) { while (1) { - register Lisp_Object map, tem; + if (!(CONSP (object))) + /* This is really the value. */ + return object; - /* If the contents are (KEYMAP . ELEMENT), go indirect. */ - map = get_keymap_1 (Fcar_safe (object), 0, autoload); - tem = Fkeymapp (map); - if (!NILP (tem)) + /* If the keymap contents looks like (keymap ...) or (lambda ...) + then use itself. */ + else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda)) + return object; + + /* If the keymap contents looks like (menu-item name . DEFN) + or (menu-item name DEFN ...) then use DEFN. + This is a new format menu item. */ + else if (EQ (XCAR (object), Qmenu_item)) { - Lisp_Object key; - key = Fcdr (object); - if (INTEGERP (key) && (XINT (key) & meta_modifier)) + if (CONSP (XCDR (object))) { - object = access_keymap (map, meta_prefix_char, 0, 0); - map = get_keymap_1 (object, 0, autoload); - object = access_keymap (map, - make_number (XINT (key) & ~meta_modifier), - 0, 0); + Lisp_Object tem; + + object = XCDR (XCDR (object)); + tem = object; + if (CONSP (object)) + object = XCAR (object); + + /* If there's a `:filter FILTER', apply FILTER to the + menu-item's definition to get the real definition to + use. Temporarily inhibit GC while evaluating FILTER, + because not functions calling get_keyelt are prepared + for a GC. */ + for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem)) + if (EQ (XCAR (tem), QCfilter)) + { + int count = inhibit_garbage_collection (); + Lisp_Object filter; + filter = XCAR (XCDR (tem)); + filter = list2 (filter, list2 (Qquote, object)); + object = menu_item_eval_property (filter); + unbind_to (count, Qnil); + break; + } } else - object = access_keymap (map, key, 0, 0); + /* Invalid keymap */ + return object; } - /* If the keymap contents looks like (STRING . DEFN), - use DEFN. + /* If the keymap contents looks like (STRING . DEFN), use DEFN. Keymap alist elements like (CHAR MENUSTRING . DEFN) will be used by HierarKey menus. */ - else if (CONSP (object) - && STRINGP (XCONS (object)->car)) + else if (STRINGP (XCAR (object))) { - object = XCONS (object)->cdr; + object = XCDR (object); /* Also remove a menu help string, if any, following the menu item name. */ - if (CONSP (object) && STRINGP (XCONS (object)->car)) - object = XCONS (object)->cdr; + if (CONSP (object) && STRINGP (XCAR (object))) + object = XCDR (object); /* Also remove the sublist that caches key equivalences, if any. */ - if (CONSP (object) - && CONSP (XCONS (object)->car)) + if (CONSP (object) && CONSP (XCAR (object))) { Lisp_Object carcar; - carcar = XCONS (XCONS (object)->car)->car; + carcar = XCAR (XCAR (object)); if (NILP (carcar) || VECTORP (carcar)) - object = XCONS (object)->cdr; + object = XCDR (object); } } + /* If the contents are (KEYMAP . ELEMENT), go indirect. */ else - /* Anything else is really the value. */ - return object; + { + Lisp_Object map; + + map = get_keymap_1 (Fcar_safe (object), 0, autoload); + if (NILP (map)) + /* Invalid keymap */ + return object; + else + { + Lisp_Object key; + key = Fcdr (object); + if (INTEGERP (key) && (XUINT (key) & meta_modifier)) + { + object = access_keymap (map, meta_prefix_char, 0, 0); + map = get_keymap_1 (object, 0, autoload); + object = access_keymap (map, make_number (XINT (key) + & ~meta_modifier), + 0, 0); + } + else + object = access_keymap (map, key, 0, 0); + } + } } } -Lisp_Object +static Lisp_Object store_in_keymap (keymap, idx, def) Lisp_Object keymap; register Lisp_Object idx; register Lisp_Object def; { /* If we are preparing to dump, and DEF is a menu element - with a menu item string, copy it to ensure it is not pure. */ - if (CONSP (def) && PURE_P (def) && STRINGP (XCONS (def)->car)) - def = Fcons (XCONS (def)->car, XCONS (def)->cdr); + with a menu item indicator, copy it to ensure it is not pure. */ + if (CONSP (def) && PURE_P (def) + && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def)))) + def = Fcons (XCAR (def), XCDR (def)); - if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap)) + if (!CONSP (keymap) || ! EQ (XCAR (keymap), Qkeymap)) error ("attempt to define a key in a non-keymap"); /* If idx is a list (some sort of mouse click, perhaps?), @@ -622,11 +728,11 @@ store_in_keymap (keymap, idx, def) Lisp_Object insertion_point; insertion_point = keymap; - for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail)) { Lisp_Object elt; - elt = XCONS (tail)->car; + elt = XCAR (tail); if (VECTORP (elt)) { if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (elt)->size) @@ -653,9 +759,9 @@ store_in_keymap (keymap, idx, def) } else if (CONSP (elt)) { - if (EQ (idx, XCONS (elt)->car)) + if (EQ (idx, XCAR (elt))) { - XCONS (elt)->cdr = def; + XCDR (elt) = def; return def; } } @@ -675,8 +781,8 @@ store_in_keymap (keymap, idx, def) keymap_end: /* We have scanned the entire keymap, and not found a binding for IDX. Let's add one. */ - XCONS (insertion_point)->cdr - = Fcons (Fcons (idx, def), XCONS (insertion_point)->cdr); + XCDR (insertion_point) + = Fcons (Fcons (idx, def), XCDR (insertion_point)); } return def; @@ -704,17 +810,17 @@ is not copied.") copy = Fcopy_alist (get_keymap (keymap)); - for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = copy; CONSP (tail); tail = XCDR (tail)) { Lisp_Object elt; - elt = XCONS (tail)->car; + elt = XCAR (tail); if (CHAR_TABLE_P (elt)) { Lisp_Object indices[3]; elt = Fcopy_sequence (elt); - XCONS (tail)->car = elt; + XCAR (tail) = elt; map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices); } @@ -723,7 +829,7 @@ is not copied.") int i; elt = Fcopy_sequence (elt); - XCONS (tail)->car = elt; + XCAR (tail) = elt; for (i = 0; i < XVECTOR (elt)->size; i++) if (!SYMBOLP (XVECTOR (elt)->contents[i]) @@ -731,42 +837,80 @@ is not copied.") XVECTOR (elt)->contents[i] = Fcopy_keymap (XVECTOR (elt)->contents[i]); } - else if (CONSP (elt)) + else if (CONSP (elt) && CONSP (XCDR (elt))) { - /* Skip the optional menu string. */ - if (CONSP (XCONS (elt)->cdr) - && STRINGP (XCONS (XCONS (elt)->cdr)->car)) - { - Lisp_Object tem; - - /* Copy the cell, since copy-alist didn't go this deep. */ - XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car, - XCONS (XCONS (elt)->cdr)->cdr); - elt = XCONS (elt)->cdr; + Lisp_Object tem; + tem = XCDR (elt); - /* Also skip the optional menu help string. */ - if (CONSP (XCONS (elt)->cdr) - && STRINGP (XCONS (XCONS (elt)->cdr)->car)) + /* Is this a new format menu item. */ + if (EQ (XCAR (tem),Qmenu_item)) + { + /* Copy cell with menu-item marker. */ + XCDR (elt) + = Fcons (XCAR (tem), XCDR (tem)); + elt = XCDR (elt); + tem = XCDR (elt); + if (CONSP (tem)) + { + /* Copy cell with menu-item name. */ + XCDR (elt) + = Fcons (XCAR (tem), XCDR (tem)); + elt = XCDR (elt); + tem = XCDR (elt); + }; + if (CONSP (tem)) { - XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car, - XCONS (XCONS (elt)->cdr)->cdr); - elt = XCONS (elt)->cdr; + /* Copy cell with binding and if the binding is a keymap, + copy that. */ + XCDR (elt) + = Fcons (XCAR (tem), XCDR (tem)); + elt = XCDR (elt); + tem = XCAR (elt); + if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem)))) + XCAR (elt) = Fcopy_keymap (tem); + tem = XCDR (elt); + if (CONSP (tem) && CONSP (XCAR (tem))) + /* Delete cache for key equivalences. */ + XCDR (elt) = XCDR (tem); } - /* There may also be a list that caches key equivalences. - Just delete it for the new keymap. */ - if (CONSP (XCONS (elt)->cdr) - && CONSP (XCONS (XCONS (elt)->cdr)->car) - && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car) - || VECTORP (tem))) - XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr; } - if (CONSP (elt) - && ! SYMBOLP (XCONS (elt)->cdr) - && ! NILP (Fkeymapp (XCONS (elt)->cdr))) - XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr); + else + { + /* It may be an old fomat menu item. + Skip the optional menu string. + */ + if (STRINGP (XCAR (tem))) + { + /* Copy the cell, since copy-alist didn't go this deep. */ + XCDR (elt) + = Fcons (XCAR (tem), XCDR (tem)); + elt = XCDR (elt); + tem = XCDR (elt); + /* Also skip the optional menu help string. */ + if (CONSP (tem) && STRINGP (XCAR (tem))) + { + XCDR (elt) + = Fcons (XCAR (tem), XCDR (tem)); + elt = XCDR (elt); + tem = XCDR (elt); + } + /* There may also be a list that caches key equivalences. + Just delete it for the new keymap. */ + if (CONSP (tem) + && CONSP (XCAR (tem)) + && (NILP (XCAR (XCAR (tem))) + || VECTORP (XCAR (XCAR (tem))))) + XCDR (elt) = XCDR (tem); + } + if (CONSP (elt) + && ! SYMBOLP (XCDR (elt)) + && ! NILP (Fkeymapp (XCDR (elt)))) + XCDR (elt) = Fcopy_keymap (XCDR (elt)); + } + } } - + return copy; } @@ -801,7 +945,6 @@ the front of KEYMAP.") { register int idx; register Lisp_Object c; - register Lisp_Object tem; register Lisp_Object cmd; int metized = 0; int meta_bit; @@ -896,7 +1039,6 @@ recognize the default bindings, just as `read-key-sequence' does.") Lisp_Object accept_default; { register int idx; - register Lisp_Object tem; register Lisp_Object cmd; register Lisp_Object c; int metized = 0; @@ -993,8 +1135,8 @@ define_as_prefix (keymap, c) make it define this key. */ Lisp_Object tail; - for (tail = Fcdr (keymap); CONSP (tail); tail = XCONS (tail)->cdr) - if (EQ (XCONS (tail)->car, Qkeymap)) + for (tail = Fcdr (keymap); CONSP (tail); tail = XCDR (tail)) + if (EQ (XCAR (tail), Qkeymap)) break; if (!NILP (tail)) @@ -1069,9 +1211,9 @@ current_minor_maps (modeptr, mapptr) for (list_number = 0; list_number < 2; list_number++) for (alist = lists[list_number]; CONSP (alist); - alist = XCONS (alist)->cdr) - if ((assoc = XCONS (alist)->car, CONSP (assoc)) - && (var = XCONS (assoc)->car, SYMBOLP (var)) + alist = XCDR (alist)) + if ((assoc = XCAR (alist), CONSP (assoc)) + && (var = XCAR (assoc), SYMBOLP (var)) && (val = find_symbol_value (var), ! EQ (val, Qunbound)) && ! NILP (val)) { @@ -1108,9 +1250,9 @@ current_minor_maps (modeptr, mapptr) BLOCK_INPUT; cmm_size = 30; newmodes - = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object)); + = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object)); newmaps - = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object)); + = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object)); UNBLOCK_INPUT; } @@ -1125,7 +1267,7 @@ current_minor_maps (modeptr, mapptr) /* Get the keymap definition--or nil if it is not defined. */ temp = internal_condition_case_1 (Findirect_function, - XCONS (assoc)->cdr, + XCDR (assoc), Qerror, current_minor_maps_error); if (!NILP (temp)) { @@ -1190,7 +1332,15 @@ recognize the default bindings, just as `read-key-sequence' does.") RETURN_UNGCPRO (value); } - local = get_local_map (PT, current_buffer); + local = get_local_map (PT, current_buffer, keymap); + if (! NILP (local)) + { + value = Flookup_key (local, key, accept_default); + if (! NILP (value) && !INTEGERP (value)) + RETURN_UNGCPRO (value); + } + + local = get_local_map (PT, current_buffer, local_map); if (! NILP (local)) { @@ -1289,17 +1439,19 @@ bindings; see the description of `lookup-key' for more details about this.") return Flist (j, maps); } -DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0, +DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0, "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\ A new sparse keymap is stored as COMMAND's function definition and its value.\n\ If a second optional argument MAPVAR is given, the map is stored as\n\ its value instead of as COMMAND's value; but COMMAND is still defined\n\ -as a function.") - (command, mapvar) - Lisp_Object command, mapvar; +as a function.\n\ +The third optional argument NAME, if given, supplies a menu name\n\ +string for the map. This is required to use the keymap as a menu.") + (command, mapvar, name) + Lisp_Object command, mapvar, name; { Lisp_Object map; - map = Fmake_sparse_keymap (Qnil); + map = Fmake_sparse_keymap (name); Ffset (command, map); if (!NILP (mapvar)) Fset (mapvar, map); @@ -1402,14 +1554,12 @@ then the value includes only maps for prefixes that start with PREFIX.") Lisp_Object copy; copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil); - for (i = 0, i_byte; i < XSTRING (prefix)->size;) + for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;) { int i_before = i; - if (STRING_MULTIBYTE (prefix)) - FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte); - else - c = XSTRING (prefix)->data[i++]; - if (c & 0200) + + FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte); + if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) c ^= 0200 | meta_modifier; XVECTOR (copy)->contents[i_before] = make_number (c); } @@ -1432,7 +1582,7 @@ then the value includes only maps for prefixes that start with PREFIX.") This is a breadth-first traversal, where tail is the queue of nodes, and maps accumulates a list of all nodes visited. */ - for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = maps; CONSP (tail); tail = XCDR (tail)) { register Lisp_Object thisseq, thismap; Lisp_Object last; @@ -1447,11 +1597,11 @@ then the value includes only maps for prefixes that start with PREFIX.") && XINT (last) >= prefixlen && EQ (Faref (thisseq, last), meta_prefix_char)); - for (; CONSP (thismap); thismap = XCONS (thismap)->cdr) + for (; CONSP (thismap); thismap = XCDR (thismap)) { Lisp_Object elt; - elt = XCONS (thismap)->car; + elt = XCAR (thismap); QUIT; @@ -1498,8 +1648,8 @@ then the value includes only maps for prefixes that start with PREFIX.") /* This new sequence is the same length as thisseq, so stick it in the list right after this one. */ - XCONS (tail)->cdr - = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr); + XCDR (tail) + = Fcons (Fcons (tem, cmd), XCDR (tail)); } else { @@ -1512,9 +1662,9 @@ then the value includes only maps for prefixes that start with PREFIX.") } else if (CONSP (elt)) { - register Lisp_Object cmd, tem, filter; + register Lisp_Object cmd, tem; - cmd = get_keyelt (XCONS (elt)->cdr, 0); + cmd = get_keyelt (XCDR (elt), 0); /* Ignore definitions that aren't keymaps themselves. */ tem = Fkeymapp (cmd); if (!NILP (tem)) @@ -1525,7 +1675,7 @@ then the value includes only maps for prefixes that start with PREFIX.") if (NILP (tem)) { /* Let elt be the event defined by this map entry. */ - elt = XCONS (elt)->car; + elt = XCAR (elt); /* If the last key in thisseq is meta-prefix-char, and this entry is a binding for an ascii keystroke, @@ -1542,8 +1692,8 @@ then the value includes only maps for prefixes that start with PREFIX.") /* This new sequence is the same length as thisseq, so stick it in the list right after this one. */ - XCONS (tail)->cdr - = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr); + XCDR (tail) + = Fcons (Fcons (tem, cmd), XCDR (tail)); } else nconc2 (tail, @@ -1561,11 +1711,11 @@ then the value includes only maps for prefixes that start with PREFIX.") /* Now find just the maps whose access prefixes start with PREFIX. */ good_maps = Qnil; - for (; CONSP (maps); maps = XCONS (maps)->cdr) + for (; CONSP (maps); maps = XCDR (maps)) { Lisp_Object elt, thisseq; - elt = XCONS (maps)->car; - thisseq = XCONS (elt)->car; + elt = XCAR (maps); + thisseq = XCAR (elt); /* The access prefix must be at least as long as PREFIX, and the first elements must match those of PREFIX. */ if (XINT (Flength (thisseq)) >= prefixlen) @@ -1596,9 +1746,9 @@ accessible_keymaps_char_table (args, index, cmd) if (NILP (cmd)) return; - maps = XCONS (args)->car; - tail = XCONS (XCONS (args)->cdr)->car; - thisseq = XCONS (XCONS (args)->cdr)->cdr; + maps = XCAR (args); + tail = XCAR (XCDR (args)); + thisseq = XCDR (XCDR (args)); tem = Fkeymapp (cmd); if (!NILP (tem)) @@ -1634,41 +1784,57 @@ spaces are put between sequence elements, etc.") { Lisp_Object vector; vector = Fmake_vector (Flength (keys), Qnil); - for (i = 0; i < XSTRING (keys)->size; ) + for (i = 0, i_byte = 0; i < XSTRING (keys)->size; ) { int c; int i_before = i; - if (STRING_MULTIBYTE (keys)) - FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte); - else - c = XSTRING (keys)->data[i++]; - - if (c & 0x80) - XSETFASTINT (XVECTOR (vector)->contents[i_before], - meta_modifier | (c & ~0x80)); - else - XSETFASTINT (XVECTOR (vector)->contents[i_before], c); + FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte); + if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) + c ^= 0200 | meta_modifier; + XSETFASTINT (XVECTOR (vector)->contents[i_before], c); } keys = vector; } - else if (!VECTORP (keys)) - keys = wrong_type_argument (Qarrayp, keys); - /* In effect, this computes - (mapconcat 'single-key-description keys " ") - but we shouldn't use mapconcat because it can do GC. */ + if (VECTORP (keys)) + { + /* In effect, this computes + (mapconcat 'single-key-description keys " ") + but we shouldn't use mapconcat because it can do GC. */ - len = XVECTOR (keys)->size; - sep = build_string (" "); - /* This has one extra element at the end that we don't pass to Fconcat. */ - args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object)); + len = XVECTOR (keys)->size; + sep = build_string (" "); + /* This has one extra element at the end that we don't pass to Fconcat. */ + args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object)); - for (i = 0; i < len; i++) + for (i = 0; i < len; i++) + { + args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i], + Qnil); + args[i * 2 + 1] = sep; + } + } + else if (CONSP (keys)) { - args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]); - args[i * 2 + 1] = sep; + /* In effect, this computes + (mapconcat 'single-key-description keys " ") + but we shouldn't use mapconcat because it can do GC. */ + + len = XFASTINT (Flength (keys)); + sep = build_string (" "); + /* This has one extra element at the end that we don't pass to Fconcat. */ + args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object)); + + for (i = 0; i < len; i++) + { + args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil); + args[i * 2 + 1] = sep; + keys = XCDR (keys); + } } + else + keys = wrong_type_argument (Qarrayp, keys); return Fconcat (len * 2 - 1, args); } @@ -1678,8 +1844,12 @@ push_key_description (c, p) register unsigned int c; register char *p; { + unsigned c2; + /* Clear all the meaningless bits above the meta bit. */ c &= meta_modifier | ~ - meta_modifier; + c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier + | meta_modifier | shift_modifier | super_modifier); if (c & alt_modifier) { @@ -1687,11 +1857,12 @@ push_key_description (c, p) *p++ = '-'; c -= alt_modifier; } - if (c & ctrl_modifier) + if ((c & ctrl_modifier) != 0 + || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M'))) { *p++ = 'C'; *p++ = '-'; - c -= ctrl_modifier; + c &= ~ctrl_modifier; } if (c & hyper_modifier) { @@ -1739,8 +1910,7 @@ push_key_description (c, p) } else { - *p++ = 'C'; - *p++ = '-'; + /* `C-' already added above. */ if (c > 0 && c <= Ctl ('Z')) *p++ = c + 0140; else @@ -1754,29 +1924,37 @@ push_key_description (c, p) *p++ = 'L'; } else if (c == ' ') - { + { *p++ = 'S'; *p++ = 'P'; *p++ = 'C'; } - else if (c < 128) + else if (c < 128 + || (NILP (current_buffer->enable_multibyte_characters) + && SINGLE_BYTE_CHAR_P (c))) *p++ = c; - else if (c < 512) - { - *p++ = '\\'; - *p++ = (7 & (c >> 6)) + '0'; - *p++ = (7 & (c >> 3)) + '0'; - *p++ = (7 & (c >> 0)) + '0'; - } else { - *p++ = '\\'; - *p++ = (7 & (c >> 15)) + '0'; - *p++ = (7 & (c >> 12)) + '0'; - *p++ = (7 & (c >> 9)) + '0'; - *p++ = (7 & (c >> 6)) + '0'; - *p++ = (7 & (c >> 3)) + '0'; - *p++ = (7 & (c >> 0)) + '0'; + if (! NILP (current_buffer->enable_multibyte_characters)) + c = unibyte_char_to_multibyte (c); + + if (NILP (current_buffer->enable_multibyte_characters) + || SINGLE_BYTE_CHAR_P (c) + || ! char_valid_p (c, 0)) + { + int bit_offset; + *p++ = '\\'; + /* The biggest character code uses 19 bits. */ + for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3) + { + if (c >= (1 << bit_offset)) + *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0'; + } + } + else + { + p += CHAR_STRING (c, p); + } } return p; @@ -1784,23 +1962,61 @@ push_key_description (c, p) /* This function cannot GC. */ -DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0, +DEFUN ("single-key-description", Fsingle_key_description, + Ssingle_key_description, 1, 2, 0, "Return a pretty description of command character KEY.\n\ -Control characters turn into C-whatever, etc.") - (key) - Lisp_Object key; +Control characters turn into C-whatever, etc.\n\ +Optional argument NO-ANGLES non-nil means don't put angle brackets\n\ +around function keys and event symbols.") + (key, no_angles) + Lisp_Object key, no_angles; { - char tem[20]; + if (CONSP (key) && lucid_event_type_list_p (key)) + key = Fevent_convert_list (key); key = EVENT_HEAD (key); if (INTEGERP (key)) /* Normal character */ { - *push_key_description (XUINT (key), tem) = 0; - return build_string (tem); + unsigned int charset, c1, c2; + int without_bits = XINT (key) & ~((-1) << CHARACTERBITS); + + if (SINGLE_BYTE_CHAR_P (without_bits)) + charset = 0; + else + SPLIT_CHAR (without_bits, charset, c1, c2); + + if (charset + && CHARSET_DEFINED_P (charset) + && ((c1 >= 0 && c1 < 32) + || (c2 >= 0 && c2 < 32))) + { + /* Handle a generic character. */ + Lisp_Object name; + name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX); + CHECK_STRING (name, 0); + return concat2 (build_string ("Character set "), name); + } + else + { + char tem[KEY_DESCRIPTION_SIZE]; + + *push_key_description (XUINT (key), tem) = 0; + return build_string (tem); + } } else if (SYMBOLP (key)) /* Function key or event-symbol */ - return Fsymbol_name (key); + { + if (NILP (no_angles)) + { + char *buffer + = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5); + sprintf (buffer, "<%s>", XSYMBOL (key)->name->data); + return build_string (buffer); + } + else + return Fsymbol_name (key); + } else if (STRINGP (key)) /* Buffer names in the menubar. */ return Fcopy_sequence (key); else @@ -1841,21 +2057,23 @@ Control characters turn into \"^char\", etc.") (character) Lisp_Object character; { - char tem[6]; + /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */ + unsigned char str[6]; + int c; CHECK_NUMBER (character, 0); - if (!SINGLE_BYTE_CHAR_P (XFASTINT (character))) + c = XINT (character); + if (!SINGLE_BYTE_CHAR_P (c)) { - unsigned char *str; - int len = non_ascii_char_to_string (XFASTINT (character), tem, &str); + int len = CHAR_STRING (c, str); return make_multibyte_string (str, 1, len); } - *push_text_char_description (XINT (character) & 0377, tem) = 0; + *push_text_char_description (c & 0377, str) = 0; - return build_string (tem); + return build_string (str); } /* Return non-zero if SEQ contains only ASCII characters, perhaps with @@ -1905,14 +2123,14 @@ and entirely reject menu bindings.\n\ If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\ to other keymaps or slots. This makes it possible to search for an\n\ indirect definition itself.") - (definition, keymap, firstonly, noindirect) - Lisp_Object definition, keymap; + (definition, xkeymap, firstonly, noindirect) + Lisp_Object definition, xkeymap; Lisp_Object firstonly, noindirect; { Lisp_Object maps; Lisp_Object found, sequences; Lisp_Object keymap1; - int keymap_specified = !NILP (keymap); + int keymap_specified = !NILP (xkeymap); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; /* 1 means ignore all menu bindings entirely. */ int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); @@ -1921,22 +2139,27 @@ indirect definition itself.") context. But don't muck with the value of `keymap', because `where_is_internal_1' uses it to check for shadowed bindings. */ - keymap1 = keymap; + keymap1 = xkeymap; if (! keymap_specified) - { -#ifdef USE_TEXT_PROPERTIES - keymap1 = get_local_map (PT, current_buffer); -#else - keymap1 = current_buffer->keymap; -#endif - } + keymap1 = get_local_map (PT, current_buffer, keymap); if (!NILP (keymap1)) maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil), Faccessible_keymaps (get_keymap (current_global_map), Qnil)); else - maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil); + { + keymap1 = xkeymap; + if (! keymap_specified) + keymap1 = get_local_map (PT, current_buffer, local_map); + + if (!NILP (keymap1)) + maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil), + Faccessible_keymaps (get_keymap (current_global_map), + Qnil)); + else + maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil); + } /* Put the minor mode keymaps on the front. */ if (! keymap_specified) @@ -1945,14 +2168,14 @@ indirect definition itself.") minors = Fnreverse (Fcurrent_minor_mode_maps ()); while (!NILP (minors)) { - maps = nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors)->car), + maps = nconc2 (Faccessible_keymaps (get_keymap (XCAR (minors)), Qnil), maps); - minors = XCONS (minors)->cdr; + minors = XCDR (minors); } } - GCPRO5 (definition, keymap, maps, found, sequences); + GCPRO5 (definition, xkeymap, maps, found, sequences); found = Qnil; sequences = Qnil; @@ -1986,8 +2209,8 @@ indirect definition itself.") advance map to the next element until i indicates that we have finished off the vector. */ Lisp_Object elt, key, binding; - elt = XCONS (map)->car; - map = XCONS (map)->cdr; + elt = XCAR (map); + map = XCDR (map); sequences = Qnil; @@ -2005,7 +2228,7 @@ indirect definition itself.") binding = XVECTOR (elt)->contents[i]; XSETFASTINT (key, i); sequence = where_is_internal_1 (binding, key, definition, - noindirect, keymap, this, + noindirect, xkeymap, this, last, nomenus, last_is_meta); if (!NILP (sequence)) sequences = Fcons (sequence, sequences); @@ -2017,35 +2240,34 @@ indirect definition itself.") Lisp_Object args; args = Fcons (Fcons (Fcons (definition, noindirect), - Fcons (keymap, Qnil)), + Fcons (xkeymap, Qnil)), Fcons (Fcons (this, last), Fcons (make_number (nomenus), make_number (last_is_meta)))); - map_char_table (where_is_internal_2, Qnil, elt, args, 0, indices); - sequences = XCONS (XCONS (XCONS (args)->car)->cdr)->cdr; + sequences = XCDR (XCDR (XCAR (args))); } else if (CONSP (elt)) { Lisp_Object sequence; - key = XCONS (elt)->car; - binding = XCONS (elt)->cdr; + key = XCAR (elt); + binding = XCDR (elt); sequence = where_is_internal_1 (binding, key, definition, - noindirect, keymap, this, + noindirect, xkeymap, this, last, nomenus, last_is_meta); if (!NILP (sequence)) sequences = Fcons (sequence, sequences); } - for (; ! NILP (sequences); sequences = XCONS (sequences)->cdr) + for (; ! NILP (sequences); sequences = XCDR (sequences)) { Lisp_Object sequence; - sequence = XCONS (sequences)->car; + sequence = XCAR (sequences); /* It is a true unshadowed match. Record it, unless it's already been seen (as could happen when inheriting keymaps). */ @@ -2083,7 +2305,10 @@ indirect definition itself.") . ((THIS . LAST) . (NOMENUS . LAST_IS_META))) Since map_char_table doesn't really use the return value from this function, - we the result append to RESULT, the slot in ARGS. */ + we the result append to RESULT, the slot in ARGS. + + This function can GC because it calls where_is_internal_1 which can + GC. */ static void where_is_internal_2 (args, key, binding) @@ -2092,24 +2317,31 @@ where_is_internal_2 (args, key, binding) Lisp_Object definition, noindirect, keymap, this, last; Lisp_Object result, sequence; int nomenus, last_is_meta; + struct gcpro gcpro1, gcpro2, gcpro3; - result = XCONS (XCONS (XCONS (args)->car)->cdr)->cdr; - definition = XCONS (XCONS (XCONS (args)->car)->car)->car; - noindirect = XCONS (XCONS (XCONS (args)->car)->car)->cdr; - keymap = XCONS (XCONS (XCONS (args)->car)->cdr)->car; - this = XCONS (XCONS (XCONS (args)->cdr)->car)->car; - last = XCONS (XCONS (XCONS (args)->cdr)->car)->cdr; - nomenus = XFASTINT (XCONS (XCONS (XCONS (args)->cdr)->cdr)->car); - last_is_meta = XFASTINT (XCONS (XCONS (XCONS (args)->cdr)->cdr)->cdr); + GCPRO3 (args, key, binding); + result = XCDR (XCDR (XCAR (args))); + definition = XCAR (XCAR (XCAR (args))); + noindirect = XCDR (XCAR (XCAR (args))); + keymap = XCAR (XCDR (XCAR (args))); + this = XCAR (XCAR (XCDR (args))); + last = XCDR (XCAR (XCDR (args))); + nomenus = XFASTINT (XCAR (XCDR (XCDR (args)))); + last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args)))); sequence = where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last, nomenus, last_is_meta); if (!NILP (sequence)) - XCONS (XCONS (XCONS (args)->car)->cdr)->cdr - = Fcons (sequence, result); + XCDR (XCDR (XCAR (args))) = Fcons (sequence, result); + + UNGCPRO; } + +/* This function can GC.because Flookup_key calls get_keymap_1 with + non-zero argument AUTOLOAD. */ + static Lisp_Object where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last, nomenus, last_is_meta) @@ -2118,6 +2350,7 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last, { Lisp_Object sequence; int keymap_specified = !NILP (keymap); + struct gcpro gcpro1, gcpro2; /* Search through indirections unless that's not wanted. */ if (NILP (noindirect)) @@ -2135,9 +2368,10 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last, else break; } - /* If the contents are (STRING ...), reject. */ + /* If the contents are (menu-item ...) or (STRING ...), reject. */ if (CONSP (definition) - && STRINGP (XCONS (definition)->car)) + && (EQ (XCAR (definition),Qmenu_item) + || STRINGP (XCAR (definition)))) return Qnil; } else @@ -2177,6 +2411,7 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last, Either nil or number as value from Flookup_key means undefined. */ + GCPRO2 (sequence, binding); if (keymap_specified) { binding = Flookup_key (keymap, sequence, Qnil); @@ -2187,59 +2422,67 @@ where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last, Lisp_Object tem; tem = Fequal (binding, definition); if (NILP (tem)) - return Qnil; + RETURN_UNGCPRO (Qnil); } else if (!EQ (binding, definition)) - return Qnil; + RETURN_UNGCPRO (Qnil); } } else { binding = Fkey_binding (sequence, Qnil); if (!EQ (binding, definition)) - return Qnil; + RETURN_UNGCPRO (Qnil); } - return sequence; + RETURN_UNGCPRO (sequence); } /* describe-bindings - summarizing all the bindings in a set of keymaps. */ -DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "", +DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "", "Show a list of all defined keys, and their definitions.\n\ -The list is put in a buffer, which is displayed.\n\ -An optional argument PREFIX, if non-nil, should be a key sequence;\n\ +We put that list in a buffer, and display the buffer.\n\ +\n\ +The optional argument MENUS, if non-nil, says to mention menu bindings.\n\ +\(Ordinarily these are omitted from the output.)\n\ +The optional argument PREFIX, if non-nil, should be a key sequence;\n\ then we display only bindings that start with that prefix.") - (prefix) - Lisp_Object prefix; + (menus, prefix) + Lisp_Object menus, prefix; { register Lisp_Object thisbuf; XSETBUFFER (thisbuf, current_buffer); internal_with_output_to_temp_buffer ("*Help*", describe_buffer_bindings, - Fcons (thisbuf, prefix)); + list3 (thisbuf, prefix, menus)); return Qnil; } -/* ARG is (BUFFER . PREFIX). */ +/* ARG is (BUFFER PREFIX MENU-FLAG). */ static Lisp_Object describe_buffer_bindings (arg) Lisp_Object arg; { Lisp_Object descbuf, prefix, shadow; + int nomenu; register Lisp_Object start1; struct gcpro gcpro1; char *alternate_heading = "\ -Alternate Characters (use anywhere the nominal character is listed):\n\ -nominal alternate\n\ -------- ---------\n"; +Keyboard translations:\n\n\ +You type Translation\n\ +-------- -----------\n"; + + descbuf = XCAR (arg); + arg = XCDR (arg); + prefix = XCAR (arg); + arg = XCDR (arg); + nomenu = NILP (XCAR (arg)); - descbuf = XCONS (arg)->car; - prefix = XCONS (arg)->cdr; shadow = Qnil; GCPRO1 (shadow); @@ -2255,7 +2498,7 @@ nominal alternate\n\ for (c = 0; c < translate_len; c++) if (translate[c] != c) { - char buf[20]; + char buf[KEY_DESCRIPTION_SIZE]; char *bufend; if (alternate_heading) @@ -2278,7 +2521,7 @@ nominal alternate\n\ if (!NILP (Vkey_translation_map)) describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, - "Key translations", 0, 1, 0); + "Key translations", nomenu, 1, 0); { int i, nmaps; @@ -2307,7 +2550,9 @@ nominal alternate\n\ if (!SYMBOLP (modes[i])) abort(); - p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size); + p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size); + *p++ = '\f'; + *p++ = '\n'; *p++ = '`'; bcopy (XSYMBOL (modes[i])->name->data, p, XSYMBOL (modes[i])->name->size); @@ -2317,7 +2562,7 @@ nominal alternate\n\ p += sizeof (" Minor Mode Bindings") - 1; *p = 0; - describe_map_tree (maps[i], 1, shadow, prefix, title, 0, 0, 0); + describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0); shadow = Fcons (maps[i], shadow); } } @@ -2333,17 +2578,17 @@ nominal alternate\n\ if (!NILP (start1)) { describe_map_tree (start1, 1, shadow, prefix, - "Major Mode Bindings", 0, 0, 0); + "\f\nMajor Mode Bindings", nomenu, 0, 0); shadow = Fcons (start1, shadow); } describe_map_tree (current_global_map, 1, shadow, prefix, - "Global Bindings", 0, 0, 1); + "\f\nGlobal Bindings", nomenu, 0, 1); /* Print the function-key-map translations under this prefix. */ if (!NILP (Vfunction_key_map)) describe_map_tree (Vfunction_key_map, 0, Qnil, prefix, - "Function key map translations", 0, 1, 0); + "\f\nFunction key map translations", nomenu, 1, 0); call0 (intern ("help-mode")); Fset_buffer (descbuf); @@ -2378,7 +2623,7 @@ describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl, int transl; int always_title; { - Lisp_Object maps, seen, sub_shadows; + Lisp_Object maps, orig_maps, seen, sub_shadows; struct gcpro gcpro1, gcpro2, gcpro3; int something = 0; char *key_heading @@ -2386,7 +2631,7 @@ describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl, key binding\n\ --- -------\n"; - maps = Faccessible_keymaps (startmap, prefix); + orig_maps = maps = Faccessible_keymaps (startmap, prefix); seen = Qnil; sub_shadows = Qnil; GCPRO3 (maps, seen, sub_shadows); @@ -2396,7 +2641,7 @@ key binding\n\ Lisp_Object list; /* Delete from MAPS each element that is for the menu bar. */ - for (list = maps; !NILP (list); list = XCONS (list)->cdr) + for (list = maps; !NILP (list); list = XCDR (list)) { Lisp_Object elt, prefix, tem; @@ -2436,11 +2681,11 @@ key binding\n\ sub_shadows = Qnil; - for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = shadow; CONSP (tail); tail = XCDR (tail)) { Lisp_Object shmap; - shmap = XCONS (tail)->car; + shmap = XCAR (tail); /* If the sequence by which we reach this keymap is zero-length, then the shadow map for this keymap is just SHADOW. */ @@ -2467,7 +2712,16 @@ key binding\n\ sub_shadows = Fcons (shmap, sub_shadows); } - describe_map (Fcdr (elt), Fcar (elt), + /* Maps we have already listed in this loop shadow this map. */ + for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail)) + { + Lisp_Object tem; + tem = Fequal (Fcar (XCAR (tail)), prefix); + if (! NILP (tem)) + sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows); + } + + describe_map (Fcdr (elt), prefix, transl ? describe_translation : describe_command, partial, sub_shadows, &seen, nomenu); @@ -2561,9 +2815,9 @@ shadow_lookup (shadow, key, flag) { Lisp_Object tail, value; - for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = shadow; CONSP (tail); tail = XCDR (tail)) { - value = Flookup_key (XCONS (tail)->car, key, flag); + value = Flookup_key (XCAR (tail), key, flag); if (!NILP (value)) return value; } @@ -2612,18 +2866,18 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) GCPRO3 (elt_prefix, definition, kludge); - for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = map; CONSP (tail); tail = XCDR (tail)) { QUIT; - if (VECTORP (XCONS (tail)->car) - || CHAR_TABLE_P (XCONS (tail)->car)) - describe_vector (XCONS (tail)->car, + if (VECTORP (XCAR (tail)) + || CHAR_TABLE_P (XCAR (tail))) + describe_vector (XCAR (tail), elt_prefix, elt_describer, partial, shadow, map, (int *)0, 0); - else if (CONSP (XCONS (tail)->car)) + else if (CONSP (XCAR (tail))) { - event = XCONS (XCONS (tail)->car)->car; + event = XCAR (XCAR (tail)); /* Ignore bindings whose "keys" are not really valid events. (We get these in the frames and buffers menu.) */ @@ -2633,7 +2887,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) if (nomenu && EQ (event, Qmenu_bar)) continue; - definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0); + definition = get_keyelt (XCDR (XCAR (tail)), 0); /* Don't show undefined commands or suppressed commands. */ if (NILP (definition)) continue; @@ -2668,20 +2922,20 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) insert1 (elt_prefix); /* THIS gets the string to describe the character EVENT. */ - insert1 (Fsingle_key_description (event)); + insert1 (Fsingle_key_description (event, Qnil)); /* Print a description of the definition of this character. elt_describer will take care of spacing out far enough for alignment purposes. */ (*elt_describer) (definition); } - else if (EQ (XCONS (tail)->car, Qkeymap)) + else if (EQ (XCAR (tail), Qkeymap)) { /* The same keymap might be in the structure twice, if we're using an inherited keymap. So skip anything we've already encountered. */ tem = Fassq (tail, *seen); - if (CONSP (tem) && !NILP (Fequal (XCONS (tem)->car, keys))) + if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys))) break; *seen = Fcons (Fcons (tail, keys), *seen); } @@ -2764,7 +3018,7 @@ describe_vector (vector, elt_prefix, elt_describer, Lisp_Object suppress; Lisp_Object kludge; int first = 1; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + struct gcpro gcpro1, gcpro2, gcpro3; /* Range of elements to be handled. */ int from, to; /* A flag to tell if a leaf in this level of char-table is not a @@ -2867,8 +3121,7 @@ describe_vector (vector, elt_prefix, elt_describer, } else if (complete_char) { - character - = MAKE_NON_ASCII_CHAR (indices[0], indices[1], indices[2]); + character = MAKE_CHAR (indices[0], indices[1], indices[2]); } else character = 0; @@ -2934,7 +3187,7 @@ describe_vector (vector, elt_prefix, elt_describer, else if (CHAR_TABLE_P (vector)) { if (complete_char) - insert1 (Fsingle_key_description (make_number (character))); + insert1 (Fsingle_key_description (make_number (character), Qnil)); else { /* Print the information for this character set. */ @@ -2942,7 +3195,7 @@ describe_vector (vector, elt_prefix, elt_describer, tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX); if (STRINGP (tem2)) insert_from_string (tem2, 0, 0, XSTRING (tem2)->size, - XSTRING (tem2)->size_byte, 0); + STRING_BYTES (XSTRING (tem2)), 0); else insert ("?", 1); insert (">", 1); @@ -2950,7 +3203,7 @@ describe_vector (vector, elt_prefix, elt_describer, } else { - insert1 (Fsingle_key_description (make_number (character))); + insert1 (Fsingle_key_description (make_number (character), Qnil)); } /* If we find a sub char-table within a char-table, @@ -3006,13 +3259,12 @@ describe_vector (vector, elt_prefix, elt_describer, { if (char_table_depth == 0) { - insert1 (Fsingle_key_description (make_number (i))); + insert1 (Fsingle_key_description (make_number (i), Qnil)); } else if (complete_char) { indices[char_table_depth] = i; - character - = MAKE_NON_ASCII_CHAR (indices[0], indices[1], indices[2]); + character = MAKE_CHAR (indices[0], indices[1], indices[2]); insert_char (character); } else @@ -3026,7 +3278,7 @@ describe_vector (vector, elt_prefix, elt_describer, } else { - insert1 (Fsingle_key_description (make_number (i))); + insert1 (Fsingle_key_description (make_number (i), Qnil)); } } @@ -3083,10 +3335,9 @@ Return list of symbols found.") return apropos_accumulate; } +void syms_of_keymap () { - Lisp_Object tem; - Qkeymap = intern ("keymap"); staticpro (&Qkeymap); @@ -3189,6 +3440,9 @@ and applies even for keys that have ordinary bindings."); Qnon_ascii = intern ("non-ascii"); staticpro (&Qnon_ascii); + Qmenu_item = intern ("menu-item"); + staticpro (&Qmenu_item); + defsubr (&Skeymapp); defsubr (&Skeymap_parent); defsubr (&Sset_keymap_parent); @@ -3213,14 +3467,13 @@ and applies even for keys that have ordinary bindings."); defsubr (&Ssingle_key_description); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); - defsubr (&Sdescribe_bindings); + defsubr (&Sdescribe_bindings_internal); defsubr (&Sapropos_internal); } +void keys_of_keymap () { - Lisp_Object tem; - initial_define_key (global_map, 033, "ESC-prefix"); initial_define_key (global_map, Ctl('X'), "Control-X-prefix"); }