diff options
Diffstat (limited to 'src/keymap.c')
| -rw-r--r-- | src/keymap.c | 741 |
1 files changed, 218 insertions, 523 deletions
diff --git a/src/keymap.c b/src/keymap.c index cfba98c72f2..e22eb411f63 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -89,11 +89,6 @@ static Lisp_Object where_is_cache_keymaps; static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object); -static void describe_command (Lisp_Object, Lisp_Object); -static void describe_translation (Lisp_Object, Lisp_Object); -static void describe_map (Lisp_Object, Lisp_Object, - void (*) (Lisp_Object, Lisp_Object), - bool, Lisp_Object, Lisp_Object *, bool, bool); static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object, void (*) (Lisp_Object, Lisp_Object), bool, Lisp_Object, Lisp_Object, bool, bool); @@ -679,6 +674,23 @@ usage: (map-keymap FUNCTION KEYMAP) */) return Qnil; } +DEFUN ("keymap--get-keyelt", Fkeymap__get_keyelt, Skeymap__get_keyelt, 2, 2, 0, + doc: /* Given OBJECT which was found in a slot in a keymap, +trace indirect definitions to get the actual definition of that slot. +An indirect definition is a list of the form +(KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one +and INDEX is the object to look up in KEYMAP to yield the definition. + +Also if OBJECT has a menu string as the first element, +remove that. Also remove a menu help string as second element. + +If AUTOLOAD, load autoloadable keymaps +that are referred to with indirection. */) + (Lisp_Object object, Lisp_Object autoload) +{ + return get_keyelt (object, NILP (autoload) ? false : true); +} + /* Given OBJECT which was found in a slot in a keymap, trace indirect definitions to get the actual definition of that slot. An indirect definition is a list of the form @@ -1949,8 +1961,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) for (ptrdiff_t i = 0; i < SCHARS (prefix); ) { ptrdiff_t i_before = i; - int c; - FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte); + int c = fetch_string_char_advance (prefix, &i, &i_byte); if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) c ^= 0200 | meta_modifier; ASET (copy, i_before, make_fixnum (c)); @@ -2006,23 +2017,16 @@ For an approximate inverse of this, see `kbd'. */) (Lisp_Object keys, Lisp_Object prefix) { ptrdiff_t len = 0; - EMACS_INT i; - ptrdiff_t i_byte; Lisp_Object *args; - EMACS_INT size = XFIXNUM (Flength (keys)); - Lisp_Object list; + EMACS_INT nkeys = XFIXNUM (Flength (keys)); + EMACS_INT nprefix = XFIXNUM (Flength (prefix)); Lisp_Object sep = build_string (" "); - Lisp_Object key; - Lisp_Object result; - bool add_meta = 0; + bool add_meta = false; USE_SAFE_ALLOCA; - if (!NILP (prefix)) - size += XFIXNUM (Flength (prefix)); - /* This has one extra element at the end that we don't pass to Fconcat. */ - EMACS_INT size4; - if (INT_MULTIPLY_WRAPV (size, 4, &size4)) + ptrdiff_t size4; + if (INT_MULTIPLY_WRAPV (nkeys + nprefix, 4, &size4)) memory_full (SIZE_MAX); SAFE_ALLOCA_LISP (args, size4); @@ -2030,82 +2034,76 @@ For an approximate inverse of this, see `kbd'. */) (mapconcat 'single-key-description keys " ") but we shouldn't use mapconcat because it can do GC. */ - next_list: - if (!NILP (prefix)) - list = prefix, prefix = Qnil; - else if (!NILP (keys)) - list = keys, keys = Qnil; - else + Lisp_Object lists[2] = { prefix, keys }; + ptrdiff_t listlens[2] = { nprefix, nkeys }; + for (int li = 0; li < ARRAYELTS (lists); li++) { - if (add_meta) - { - args[len] = Fsingle_key_description (meta_prefix_char, Qnil); - result = Fconcat (len + 1, args); - } - else if (len == 0) - result = empty_unibyte_string; - else - result = Fconcat (len - 1, args); - SAFE_FREE (); - return result; - } + Lisp_Object list = lists[li]; + ptrdiff_t listlen = listlens[li], i_byte = 0; - if (STRINGP (list)) - size = SCHARS (list); - else if (VECTORP (list)) - size = ASIZE (list); - else if (CONSP (list)) - size = list_length (list); - else - wrong_type_argument (Qarrayp, list); + if (! (NILP (list) || STRINGP (list) || VECTORP (list) || CONSP (list))) + wrong_type_argument (Qarrayp, list); - i = i_byte = 0; - - while (i < size) - { - if (STRINGP (list)) - { - int c; - FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte); - if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) - c ^= 0200 | meta_modifier; - XSETFASTINT (key, c); - } - else if (VECTORP (list)) - { - key = AREF (list, i); i++; - } - else + for (ptrdiff_t i = 0; i < listlen; ) { - key = XCAR (list); - list = XCDR (list); - i++; - } - - if (add_meta) - { - if (!FIXNUMP (key) - || EQ (key, meta_prefix_char) - || (XFIXNUM (key) & meta_modifier)) + Lisp_Object key; + if (STRINGP (list)) { - args[len++] = Fsingle_key_description (meta_prefix_char, Qnil); - args[len++] = sep; - if (EQ (key, meta_prefix_char)) - continue; + int c = fetch_string_char_advance (list, &i, &i_byte); + if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) + c ^= 0200 | meta_modifier; + key = make_fixnum (c); + } + else if (VECTORP (list)) + { + key = AREF (list, i); + i++; } else - XSETINT (key, XFIXNUM (key) | meta_modifier); - add_meta = 0; - } - else if (EQ (key, meta_prefix_char)) - { - add_meta = 1; - continue; + { + key = XCAR (list); + list = XCDR (list); + i++; + } + + if (add_meta) + { + if (!FIXNUMP (key) + || EQ (key, meta_prefix_char) + || (XFIXNUM (key) & meta_modifier)) + { + args[len++] = Fsingle_key_description (meta_prefix_char, + Qnil); + args[len++] = sep; + if (EQ (key, meta_prefix_char)) + continue; + } + else + key = make_fixnum (XFIXNUM (key) | meta_modifier); + add_meta = false; + } + else if (EQ (key, meta_prefix_char)) + { + add_meta = true; + continue; + } + args[len++] = Fsingle_key_description (key, Qnil); + args[len++] = sep; } - args[len++] = Fsingle_key_description (key, Qnil); - args[len++] = sep; } - goto next_list; + + Lisp_Object result; + if (add_meta) + { + args[len] = Fsingle_key_description (meta_prefix_char, Qnil); + result = Fconcat (len + 1, args); + } + else if (len == 0) + result = empty_unibyte_string; + else + result = Fconcat (len - 1, args); + SAFE_FREE (); + return result; } @@ -2282,12 +2280,6 @@ See `text-char-description' for describing character codes. */) static char * push_text_char_description (register unsigned int c, register char *p) { - if (c >= 0200) - { - *p++ = 'M'; - *p++ = '-'; - c -= 0200; - } if (c < 040) { *p++ = '^'; @@ -2316,23 +2308,22 @@ characters into "C-char", and uses the 2**27 bit for Meta. See Info node `(elisp)Describing Characters' for examples. */) (Lisp_Object character) { - /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */ - char str[6]; - int c; - CHECK_CHARACTER (character); - c = XFIXNUM (character); + int c = XFIXNUM (character); if (!ASCII_CHAR_P (c)) { + char str[MAX_MULTIBYTE_LENGTH]; int len = CHAR_STRING (c, (unsigned char *) str); return make_multibyte_string (str, 1, len); } - - *push_text_char_description (c & 0377, str) = 0; - - return build_string (str); + else + { + char desc[4]; + int len = push_text_char_description (c, desc) - desc; + return make_string (desc, len); + } } static int where_is_preferred_modifier; @@ -2754,7 +2745,7 @@ The optional argument MENUS, if non-nil, says to mention menu bindings. (Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus) { Lisp_Object outbuf, shadow; - bool nomenu = NILP (menus); + Lisp_Object nomenu = NILP (menus) ? Qt : Qnil; Lisp_Object start1; const char *alternate_heading @@ -2803,9 +2794,13 @@ You type Translation\n\ } if (!NILP (Vkey_translation_map)) - describe_map_tree (Vkey_translation_map, 0, Qnil, prefix, - "Key translations", nomenu, 1, 0, 0); - + { + Lisp_Object msg = build_unibyte_string ("Key translations"); + CALLN (Ffuncall, + Qdescribe_map_tree, + Vkey_translation_map, Qnil, Qnil, prefix, + msg, nomenu, Qt, Qnil, Qnil); + } /* Print the (major mode) local map. */ start1 = Qnil; @@ -2814,8 +2809,11 @@ You type Translation\n\ if (!NILP (start1)) { - describe_map_tree (start1, 1, shadow, prefix, - "\f\nOverriding Bindings", nomenu, 0, 0, 0); + Lisp_Object msg = build_unibyte_string ("\f\nOverriding Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); shadow = Fcons (start1, shadow); start1 = Qnil; } @@ -2824,8 +2822,11 @@ You type Translation\n\ if (!NILP (start1)) { - describe_map_tree (start1, 1, shadow, prefix, - "\f\nOverriding Bindings", nomenu, 0, 0, 0); + Lisp_Object msg = build_unibyte_string ("\f\nOverriding Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); shadow = Fcons (start1, shadow); } else @@ -2845,9 +2846,11 @@ You type Translation\n\ XBUFFER (buffer), Qkeymap); if (!NILP (start1)) { - describe_map_tree (start1, 1, shadow, prefix, - "\f\n`keymap' Property Bindings", nomenu, - 0, 0, 0); + Lisp_Object msg = build_unibyte_string ("\f\n`keymap' Property Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); shadow = Fcons (start1, shadow); } @@ -2856,7 +2859,7 @@ You type Translation\n\ { /* The title for a minor mode keymap is constructed at run time. - We let describe_map_tree do the actual insertion + We let describe-map-tree do the actual insertion because it takes care of other features when doing so. */ char *title, *p; @@ -2876,8 +2879,11 @@ You type Translation\n\ p += strlen (" Minor Mode Bindings"); *p = 0; - describe_map_tree (maps[i], 1, shadow, prefix, - title, nomenu, 0, 0, 0); + Lisp_Object msg = build_unibyte_string (title); + CALLN (Ffuncall, + Qdescribe_map_tree, + maps[i], Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); shadow = Fcons (maps[i], shadow); SAFE_FREE (); } @@ -2887,432 +2893,66 @@ You type Translation\n\ if (!NILP (start1)) { if (EQ (start1, BVAR (XBUFFER (buffer), keymap))) - describe_map_tree (start1, 1, shadow, prefix, - "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); - else - describe_map_tree (start1, 1, shadow, prefix, - "\f\n`local-map' Property Bindings", - nomenu, 0, 0, 0); - - shadow = Fcons (start1, shadow); - } - } - - describe_map_tree (current_global_map, 1, shadow, prefix, - "\f\nGlobal Bindings", nomenu, 0, 1, 0); - - /* Print the function-key-map translations under this prefix. */ - if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) - describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix, - "\f\nFunction key map translations", nomenu, 1, 0, 0); - - /* Print the input-decode-map translations under this prefix. */ - if (!NILP (KVAR (current_kboard, Vinput_decode_map))) - describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix, - "\f\nInput decoding map translations", nomenu, 1, 0, 0); - - return Qnil; -} - -/* Insert a description of the key bindings in STARTMAP, - followed by those of all maps reachable through STARTMAP. - If PARTIAL, omit certain "uninteresting" commands - (such as `undefined'). - If SHADOW is non-nil, it is a list of maps; - don't mention keys which would be shadowed by any of them. - PREFIX, if non-nil, says mention only keys that start with PREFIX. - TITLE, if not 0, is a string to insert at the beginning. - TITLE should not end with a colon or a newline; we supply that. - If NOMENU, then omit menu-bar commands. - - If TRANSL, the definitions are actually key translations - so print strings and vectors differently. - - If ALWAYS_TITLE, print the title even if there are no maps - to look through. - - If MENTION_SHADOW, then when something is shadowed by SHADOW, - don't omit it; instead, mention it but say it is shadowed. - - Any inserted text ends in two newlines (used by `help-make-xrefs'). */ - -void -describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow, - Lisp_Object prefix, const char *title, bool nomenu, - bool transl, bool always_title, bool mention_shadow) -{ - Lisp_Object maps, orig_maps, seen, sub_shadows; - bool something = 0; - const char *key_heading - = "\ -key binding\n\ ---- -------\n"; - - orig_maps = maps = Faccessible_keymaps (startmap, prefix); - seen = Qnil; - sub_shadows = Qnil; - - if (nomenu) - { - Lisp_Object list; - - /* Delete from MAPS each element that is for the menu bar. */ - for (list = maps; CONSP (list); list = XCDR (list)) - { - Lisp_Object elt, elt_prefix, tem; - - elt = XCAR (list); - elt_prefix = Fcar (elt); - if (ASIZE (elt_prefix) >= 1) { - tem = Faref (elt_prefix, make_fixnum (0)); - if (EQ (tem, Qmenu_bar)) - maps = Fdelq (elt, maps); + Lisp_Object msg = build_unibyte_string ("\f\nMajor Mode Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); } - } - } - - if (!NILP (maps) || always_title) - { - if (title) - { - insert_string (title); - if (!NILP (prefix)) + else { - insert_string (" Starting With "); - insert1 (Fkey_description (prefix, Qnil)); + Lisp_Object msg = build_unibyte_string ("\f\n`local-map' Property Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + start1, Qt, shadow, prefix, + msg, nomenu, Qnil, Qnil, Qnil); } - insert_string (":\n"); - } - insert_string (key_heading); - something = 1; - } - for (; CONSP (maps); maps = XCDR (maps)) - { - register Lisp_Object elt, elt_prefix, tail; - - elt = XCAR (maps); - elt_prefix = Fcar (elt); - - sub_shadows = Flookup_key (shadow, elt_prefix, Qt); - if (FIXNATP (sub_shadows)) - sub_shadows = Qnil; - else if (!KEYMAPP (sub_shadows) - && !NILP (sub_shadows) - && !(CONSP (sub_shadows) - && KEYMAPP (XCAR (sub_shadows)))) - /* If elt_prefix is bound to something that's not a keymap, - it completely shadows this map, so don't - describe this map at all. */ - goto skip; - - /* 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)), elt_prefix); - if (!NILP (tem)) - sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows); + shadow = Fcons (start1, shadow); } - - describe_map (Fcdr (elt), elt_prefix, - transl ? describe_translation : describe_command, - partial, sub_shadows, &seen, nomenu, mention_shadow); - - skip: ; } - if (something) - insert_string ("\n"); -} - -static int previous_description_column; - -static void -describe_command (Lisp_Object definition, Lisp_Object args) -{ - register Lisp_Object tem1; - ptrdiff_t column = current_column (); - int description_column; + Lisp_Object msg = build_unibyte_string ("\f\nGlobal Bindings"); + CALLN (Ffuncall, + Qdescribe_map_tree, + current_global_map, Qt, shadow, prefix, + msg, nomenu, Qnil, Qt, Qnil); - /* If column 16 is no good, go to col 32; - but don't push beyond that--go to next line instead. */ - if (column > 30) + /* Print the function-key-map translations under this prefix. */ + if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) { - insert_char ('\n'); - description_column = 32; + Lisp_Object msg = build_unibyte_string ("\f\nFunction key map translations"); + CALLN (Ffuncall, + Qdescribe_map_tree, + KVAR (current_kboard, Vlocal_function_key_map), Qnil, Qnil, prefix, + msg, nomenu, Qt, Qnil, Qnil); } - else if (column > 14 || (column > 10 && previous_description_column == 32)) - description_column = 32; - else - description_column = 16; - - Findent_to (make_fixnum (description_column), make_fixnum (1)); - previous_description_column = description_column; - if (SYMBOLP (definition)) + /* Print the input-decode-map translations under this prefix. */ + if (!NILP (KVAR (current_kboard, Vinput_decode_map))) { - tem1 = SYMBOL_NAME (definition); - insert1 (tem1); - insert_string ("\n"); + Lisp_Object msg = build_unibyte_string ("\f\nInput decoding map translations"); + CALLN (Ffuncall, + Qdescribe_map_tree, + KVAR (current_kboard, Vinput_decode_map), Qnil, Qnil, prefix, + msg, nomenu, Qt, Qnil, Qnil); } - else if (STRINGP (definition) || VECTORP (definition)) - insert_string ("Keyboard Macro\n"); - else if (KEYMAPP (definition)) - insert_string ("Prefix Command\n"); - else - insert_string ("??\n"); + return Qnil; } static void -describe_translation (Lisp_Object definition, Lisp_Object args) +describe_vector_princ (Lisp_Object elt, Lisp_Object fun) { - register Lisp_Object tem1; - Findent_to (make_fixnum (16), make_fixnum (1)); - - if (SYMBOLP (definition)) - { - tem1 = SYMBOL_NAME (definition); - insert1 (tem1); - insert_string ("\n"); - } - else if (STRINGP (definition) || VECTORP (definition)) - { - insert1 (Fkey_description (definition, Qnil)); - insert_string ("\n"); - } - else if (KEYMAPP (definition)) - insert_string ("Prefix Command\n"); - else - insert_string ("??\n"); -} - -/* describe_map puts all the usable elements of a sparse keymap - into an array of `struct describe_map_elt', - then sorts them by the events. */ - -struct describe_map_elt -{ - Lisp_Object event; - Lisp_Object definition; - bool shadowed; -}; - -/* qsort comparison function for sorting `struct describe_map_elt' by - the event field. */ - -static int -describe_map_compare (const void *aa, const void *bb) -{ - const struct describe_map_elt *a = aa, *b = bb; - if (FIXNUMP (a->event) && FIXNUMP (b->event)) - return ((XFIXNUM (a->event) > XFIXNUM (b->event)) - - (XFIXNUM (a->event) < XFIXNUM (b->event))); - if (!FIXNUMP (a->event) && FIXNUMP (b->event)) - return 1; - if (FIXNUMP (a->event) && !FIXNUMP (b->event)) - return -1; - if (SYMBOLP (a->event) && SYMBOLP (b->event)) - /* Sort the keystroke names in the "natural" way, with (for - instance) "<f2>" coming between "<f1>" and "<f11>". */ - return string_version_cmp (SYMBOL_NAME (a->event), SYMBOL_NAME (b->event)); - return 0; -} - -/* Describe the contents of map MAP, assuming that this map itself is - reached by the sequence of prefix keys PREFIX (a string or vector). - PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ - -static void -describe_map (Lisp_Object map, Lisp_Object prefix, - void (*elt_describer) (Lisp_Object, Lisp_Object), - bool partial, Lisp_Object shadow, - Lisp_Object *seen, bool nomenu, bool mention_shadow) -{ - Lisp_Object tail, definition, event; - Lisp_Object tem; - Lisp_Object suppress; - Lisp_Object kludge; - bool first = 1; - - /* These accumulate the values from sparse keymap bindings, - so we can sort them and handle them in order. */ - ptrdiff_t length_needed = 0; - struct describe_map_elt *vect; - ptrdiff_t slots_used = 0; - ptrdiff_t i; - - suppress = Qnil; - - if (partial) - suppress = intern ("suppress-keymap"); - - /* This vector gets used to present single keys to Flookup_key. Since - that is done once per keymap element, we don't want to cons up a - fresh vector every time. */ - kludge = make_nil_vector (1); - definition = Qnil; - - map = call1 (Qkeymap_canonicalize, map); - - for (tail = map; CONSP (tail); tail = XCDR (tail)) - length_needed++; - - USE_SAFE_ALLOCA; - SAFE_NALLOCA (vect, 1, length_needed); - - for (tail = map; CONSP (tail); tail = XCDR (tail)) - { - maybe_quit (); - - if (VECTORP (XCAR (tail)) - || CHAR_TABLE_P (XCAR (tail))) - describe_vector (XCAR (tail), - prefix, Qnil, elt_describer, partial, shadow, map, - 1, mention_shadow); - else if (CONSP (XCAR (tail))) - { - bool this_shadowed = 0; - - event = XCAR (XCAR (tail)); - - /* Ignore bindings whose "prefix" are not really valid events. - (We get these in the frames and buffers menu.) */ - if (!(SYMBOLP (event) || FIXNUMP (event))) - continue; - - if (nomenu && EQ (event, Qmenu_bar)) - continue; - - definition = get_keyelt (XCDR (XCAR (tail)), 0); - - /* Don't show undefined commands or suppressed commands. */ - if (NILP (definition)) continue; - if (SYMBOLP (definition) && partial) - { - tem = Fget (definition, suppress); - if (!NILP (tem)) - continue; - } - - /* Don't show a command that isn't really visible - because a local definition of the same key shadows it. */ - - ASET (kludge, 0, event); - if (!NILP (shadow)) - { - tem = shadow_lookup (shadow, kludge, Qt, 0); - if (!NILP (tem)) - { - /* If both bindings are keymaps, this key is a prefix key, - so don't say it is shadowed. */ - if (KEYMAPP (definition) && KEYMAPP (tem)) - ; - /* Avoid generating duplicate entries if the - shadowed binding has the same definition. */ - else if (mention_shadow && !EQ (tem, definition)) - this_shadowed = 1; - else - continue; - } - } - - tem = Flookup_key (map, kludge, Qt); - if (!EQ (tem, definition)) continue; - - vect[slots_used].event = event; - vect[slots_used].definition = definition; - vect[slots_used].shadowed = this_shadowed; - slots_used++; - } - 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 (XCAR (tem), prefix))) - break; - *seen = Fcons (Fcons (tail, prefix), *seen); - } - } - - /* If we found some sparse map events, sort them. */ - - qsort (vect, slots_used, sizeof (struct describe_map_elt), - describe_map_compare); - - /* Now output them in sorted order. */ - - for (i = 0; i < slots_used; i++) - { - Lisp_Object start, end; - - if (first) - { - previous_description_column = 0; - insert ("\n", 1); - first = 0; - } - - ASET (kludge, 0, vect[i].event); - start = vect[i].event; - end = start; - - definition = vect[i].definition; - - /* Find consecutive chars that are identically defined. */ - if (FIXNUMP (vect[i].event)) - { - while (i + 1 < slots_used - && EQ (vect[i+1].event, make_fixnum (XFIXNUM (vect[i].event) + 1)) - && !NILP (Fequal (vect[i + 1].definition, definition)) - && vect[i].shadowed == vect[i + 1].shadowed) - i++; - end = vect[i].event; - } - - /* Now START .. END is the range to describe next. */ - - /* Insert the string to describe the event START. */ - insert1 (Fkey_description (kludge, prefix)); - - if (!EQ (start, end)) - { - insert (" .. ", 4); - - ASET (kludge, 0, end); - /* Insert the string to describe the character END. */ - insert1 (Fkey_description (kludge, prefix)); - } - - /* Print a description of the definition of this character. - elt_describer will take care of spacing out far enough - for alignment purposes. */ - (*elt_describer) (vect[i].definition, Qnil); - - if (vect[i].shadowed) - { - ptrdiff_t pt = max (PT - 1, BEG); - - SET_PT (pt); - insert_string ("\n (that binding is currently shadowed by another mode)"); - pt = min (PT + 1, Z); - SET_PT (pt); - } - } - - SAFE_FREE (); + call1 (fun, elt); + Fterpri (Qnil, Qnil); } static void -describe_vector_princ (Lisp_Object elt, Lisp_Object fun) +describe_vector_basic (Lisp_Object elt, Lisp_Object fun) { - Findent_to (make_fixnum (16), make_fixnum (1)); call1 (fun, elt); - Fterpri (Qnil, Qnil); } DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0, @@ -3332,8 +2972,40 @@ DESCRIBER is the output function used; nil means use `princ'. */) return unbind_to (count, Qnil); } +DEFUN ("help--describe-vector", Fhelp__describe_vector, Shelp__describe_vector, 7, 7, 0, + doc: /* Insert in the current buffer a description of the contents of VECTOR. +Call DESCRIBER to insert the description of one value found in VECTOR. + +PREFIX is a string describing the key which leads to the keymap that +this vector is in. + +If PARTIAL, it means do not mention suppressed commands. + +SHADOW is a list of keymaps that shadow this map. +If it is non-nil, look up the key in those maps and don't mention it +if it is defined by any of them. + +ENTIRE-MAP is the keymap in which this vector appears. +If the definition in effect in the whole map does not match +the one in this keymap, we ignore this one. */) + (Lisp_Object vector, Lisp_Object prefix, Lisp_Object describer, + Lisp_Object partial, Lisp_Object shadow, Lisp_Object entire_map, + Lisp_Object mention_shadow) +{ + ptrdiff_t count = SPECPDL_INDEX (); + specbind (Qstandard_output, Fcurrent_buffer ()); + CHECK_VECTOR_OR_CHAR_TABLE (vector); + + bool b_partial = NILP (partial) ? false : true; + bool b_mention_shadow = NILP (mention_shadow) ? false : true; + + describe_vector (vector, prefix, describer, describe_vector_basic, b_partial, + shadow, entire_map, true, b_mention_shadow); + return unbind_to (count, Qnil); +} + /* Insert in the current buffer a description of the contents of VECTOR. - We call ELT_DESCRIBER to insert the description of one value found + Call ELT_DESCRIBER to insert the description of one value found in VECTOR. ELT_PREFIX describes what "comes before" the keys or indices defined @@ -3413,6 +3085,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, for (i = from; ; i++) { bool this_shadowed = 0; + Lisp_Object shadowed_by = Qnil; int range_beg, range_end; Lisp_Object val; @@ -3455,11 +3128,9 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, /* If this binding is shadowed by some other map, ignore it. */ if (!NILP (shadow)) { - Lisp_Object tem; - - tem = shadow_lookup (shadow, kludge, Qt, 0); + shadowed_by = shadow_lookup (shadow, kludge, Qt, 0); - if (!NILP (tem)) + if (!NILP (shadowed_by) && !EQ (shadowed_by, definition)) { if (mention_shadow) this_shadowed = 1; @@ -3514,6 +3185,21 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, && !NILP (Fequal (tem2, definition))) i++; + /* Make sure found consecutive keys are either not shadowed or, + if they are, that they are shadowed by the same command. */ + if (CHAR_TABLE_P (vector) && i != starting_i) + { + Lisp_Object tem; + Lisp_Object key = make_nil_vector (1); + for (int j = starting_i + 1; j <= i; j++) + { + ASET (key, 0, make_fixnum (j)); + tem = shadow_lookup (shadow, key, Qt, 0); + if (NILP (Fequal (tem, shadowed_by))) + i = j - 1; + } + } + /* If we have a range of more than one character, print where the range reaches to. */ @@ -3537,7 +3223,13 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, if (this_shadowed) { SET_PT (PT - 1); - insert_string (" (binding currently shadowed)"); + static char const fmt[] = " (currently shadowed by `%s')"; + USE_SAFE_ALLOCA; + char *buffer = SAFE_ALLOCA (sizeof fmt + + SBYTES (SYMBOL_NAME (shadowed_by))); + esprintf (buffer, fmt, SDATA (SYMBOL_NAME (shadowed_by))); + insert_string (buffer); + SAFE_FREE(); SET_PT (PT + 1); } } @@ -3589,6 +3281,7 @@ void syms_of_keymap (void) { DEFSYM (Qkeymap, "keymap"); + DEFSYM (Qdescribe_map_tree, "describe-map-tree"); staticpro (&apropos_predicate); staticpro (&apropos_accumulate); apropos_predicate = Qnil; @@ -3729,6 +3422,8 @@ be preferred. */); defsubr (&Scurrent_active_maps); defsubr (&Saccessible_keymaps); defsubr (&Skey_description); + defsubr (&Skeymap__get_keyelt); + defsubr (&Shelp__describe_vector); defsubr (&Sdescribe_vector); defsubr (&Ssingle_key_description); defsubr (&Stext_char_description); |