From 54cbc3d4cd6541d32c02f0f5bc4decd637e2ed50 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Oct 2001 09:47:10 +0000 Subject: [PATCH] (Fkeymap_prompt, Fcurrent_active_maps): New funs. (accessible_keymaps_1): New function. (Faccessible_keymaps, accessible_keymaps_char_table): Use it. (Fwhere_is_internal): Use Fcurrent_active_maps. (Fdescribe_buffer_bindings): Renamed from describe_buffer_bindings. Insert in current buffer rather than standard-output. Don't call `help-mode'. Export to elisp. (describe_buffer_bindings): New wrapper. (syms_of_keymap): Defsubr Skeymap_prompt, Scurrent_active_maps and Sdescribe_buffer_bindings. --- src/keymap.c | 352 +++++++++++++++++++++++++-------------------------- 1 file changed, 175 insertions(+), 177 deletions(-) diff --git a/src/keymap.c b/src/keymap.c index 8f4a1cc478a..ac2727a623e 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -190,6 +190,24 @@ is also allowed as an element.") return (KEYMAPP (object) ? Qt : Qnil); } +DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0, + "Return the prompt-string of a keymap MAP.\n\ +If non-nil, the prompt is shown in the echo-area\n\ +when reading a key-sequence to be looked-up in this keymap.") + (map) + Lisp_Object map; +{ + while (CONSP (map)) + { + register Lisp_Object tem; + tem = Fcar (map); + if (STRINGP (tem)) + return tem; + map = Fcdr (map); + } + return Qnil; +} + /* Check that OBJECT is a keymap (after dereferencing through any symbols). If it is, return it. @@ -338,7 +356,7 @@ PARENT should be nil or another keymap.") 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) || KEYMAPP (list)) + if (!CONSP (list) || KEYMAPP (list)) { /* If we already have the right parent, return now so that we avoid the loops below. */ @@ -699,7 +717,7 @@ store_in_keymap (keymap, idx, def) && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def)))) def = Fcons (XCAR (def), XCDR (def)); - if (!CONSP (keymap) || ! EQ (XCAR (keymap), 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?), @@ -804,6 +822,9 @@ is not copied.") (keymap) Lisp_Object keymap; { + /* FIXME: This doesn't properly copy menu-items in vectors. */ + /* FIXME: This also copies the parent keymap. */ + register Lisp_Object copy, tail; copy = Fcopy_alist (get_keymap (keymap, 1, 0)); @@ -990,7 +1011,7 @@ the front of KEYMAP.") idx++; } - if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c)) + if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c)) error ("Key sequence contains invalid events"); if (idx == length) @@ -1038,7 +1059,7 @@ recognize the default bindings, just as `read-key-sequence' does.") register Lisp_Object cmd; register Lisp_Object c; int length; - int t_ok = ! NILP (accept_default); + int t_ok = !NILP (accept_default); struct gcpro gcpro1; keymap = get_keymap (keymap, 1, 1); @@ -1160,8 +1181,8 @@ current_minor_maps (modeptr, mapptr) alist = XCDR (alist)) if ((assoc = XCAR (alist), CONSP (assoc)) && (var = XCAR (assoc), SYMBOLP (var)) - && (val = find_symbol_value (var), ! EQ (val, Qunbound)) - && ! NILP (val)) + && (val = find_symbol_value (var), !EQ (val, Qunbound)) + && !NILP (val)) { Lisp_Object temp; @@ -1230,6 +1251,47 @@ current_minor_maps (modeptr, mapptr) return i; } +DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps, + 0, 1, 0, + "Return a list of the currently active keymaps. +OLP if non-nil indicates that we should obey `overriding-local-map' and +`overriding-terminal-local-map'.") + (olp) + Lisp_Object olp; +{ + Lisp_Object keymaps = Fcons (current_global_map, Qnil); + + if (!NILP (olp)) + { + if (!NILP (Voverriding_local_map)) + keymaps = Fcons (Voverriding_local_map, keymaps); + if (!NILP (current_kboard->Voverriding_terminal_local_map)) + keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps); + } + if (NILP (XCDR (keymaps))) + { + Lisp_Object local; + Lisp_Object *maps; + int nmaps, i; + + local = get_local_map (PT, current_buffer, Qlocal_map); + if (!NILP (local)) + keymaps = Fcons (local, keymaps); + + local = get_local_map (PT, current_buffer, Qkeymap); + if (!NILP (local)) + keymaps = Fcons (local, keymaps); + + nmaps = current_minor_maps (0, &maps); + + for (i = --nmaps; i >= 0; i--) + if (!NILP (maps[i])) + keymaps = Fcons (maps[i], keymaps); + } + + return keymaps; +} + /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0, @@ -1459,7 +1521,64 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_ /* Help functions for describing and documenting keymaps. */ -static void accessible_keymaps_char_table P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); + +static void +accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) + Lisp_Object maps, tail, thisseq, key, cmd; + int is_metized; /* If 1, `key' is assumed to be INTEGERP. */ +{ + Lisp_Object tem; + + cmd = get_keyelt (cmd, 0); + if (NILP (cmd)) + return; + + tem = get_keymap (cmd, 0, 0); + if (CONSP (tem)) + { + cmd = tem; + /* Ignore keymaps that are already added to maps. */ + tem = Frassq (cmd, maps); + if (NILP (tem)) + { + /* If the last key in thisseq is meta-prefix-char, + turn it into a meta-ized keystroke. We know + that the event we're about to append is an + ascii keystroke since we're processing a + keymap table. */ + if (is_metized) + { + int meta_bit = meta_modifier; + Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1); + tem = Fcopy_sequence (thisseq); + + Faset (tem, last, make_number (XINT (key) | meta_bit)); + + /* This new sequence is the same length as + thisseq, so stick it in the list right + after this one. */ + XCDR (tail) + = Fcons (Fcons (tem, cmd), XCDR (tail)); + } + else + { + tem = append_key (thisseq, key); + nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); + } + } + } +} + +static void +accessible_keymaps_char_table (args, index, cmd) + Lisp_Object args, index, cmd; +{ + accessible_keymaps_1 (index, cmd, + XCAR (XCAR (args)), + XCAR (XCDR (args)), + XCDR (XCDR (args)), + XINT (XCDR (XCAR (args)))); +} /* This function cannot GC. */ @@ -1568,89 +1687,15 @@ then the value includes only maps for prefixes that start with PREFIX.") /* Vector keymap. Scan all the elements. */ for (i = 0; i < ASIZE (elt); i++) - { - register Lisp_Object tem; - register Lisp_Object cmd; - - cmd = get_keyelt (AREF (elt, i), 0); - if (NILP (cmd)) continue; - tem = get_keymap (cmd, 0, 0); - if (CONSP (tem)) - { - cmd = tem; - /* Ignore keymaps that are already added to maps. */ - tem = Frassq (cmd, maps); - if (NILP (tem)) - { - /* If the last key in thisseq is meta-prefix-char, - turn it into a meta-ized keystroke. We know - that the event we're about to append is an - ascii keystroke since we're processing a - keymap table. */ - if (is_metized) - { - int meta_bit = meta_modifier; - tem = Fcopy_sequence (thisseq); - - Faset (tem, last, make_number (i | meta_bit)); - - /* This new sequence is the same length as - thisseq, so stick it in the list right - after this one. */ - XCDR (tail) - = Fcons (Fcons (tem, cmd), XCDR (tail)); - } - else - { - tem = append_key (thisseq, make_number (i)); - nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); - } - } - } - } + accessible_keymaps_1 (make_number (i), AREF (elt, i), + maps, tail, thisseq, is_metized); + } else if (CONSP (elt)) - { - register Lisp_Object cmd, tem; - - cmd = get_keyelt (XCDR (elt), 0); - /* Ignore definitions that aren't keymaps themselves. */ - tem = get_keymap (cmd, 0, 0); - if (CONSP (tem)) - { - /* Ignore keymaps that have been seen already. */ - cmd = tem; - tem = Frassq (cmd, maps); - if (NILP (tem)) - { - /* Let elt be the event defined by this map entry. */ - elt = XCAR (elt); - - /* If the last key in thisseq is meta-prefix-char, and - this entry is a binding for an ascii keystroke, - turn it into a meta-ized keystroke. */ - if (is_metized && INTEGERP (elt)) - { - Lisp_Object element; - - element = thisseq; - tem = Fvconcat (1, &element); - XSETFASTINT (AREF (tem, XINT (last)), - XINT (elt) | meta_modifier); - - /* This new sequence is the same length as - thisseq, so stick it in the list right - after this one. */ - XCDR (tail) - = Fcons (Fcons (tem, cmd), XCDR (tail)); - } - else - nconc2 (tail, - Fcons (Fcons (append_key (thisseq, elt), cmd), - Qnil)); - } - } - } + accessible_keymaps_1 (XCAR (elt), XCDR (elt), + maps, tail, thisseq, + is_metized && INTEGERP (XCAR (elt))); + } } @@ -1684,59 +1729,6 @@ then the value includes only maps for prefixes that start with PREFIX.") return Fnreverse (good_maps); } - -static void -accessible_keymaps_char_table (args, index, cmd) - Lisp_Object args, index, cmd; -{ - Lisp_Object tem; - Lisp_Object maps, tail, thisseq; - int is_metized; - - cmd = get_keyelt (cmd, 0); - if (NILP (cmd)) - return; - - maps = XCAR (XCAR (args)); - is_metized = XINT (XCDR (XCAR (args))); - tail = XCAR (XCDR (args)); - thisseq = XCDR (XCDR (args)); - - tem = get_keymap (cmd, 0, 0); - if (CONSP (tem)) - { - cmd = tem; - /* Ignore keymaps that are already added to maps. */ - tem = Frassq (cmd, maps); - if (NILP (tem)) - { - /* If the last key in thisseq is meta-prefix-char, - turn it into a meta-ized keystroke. We know - that the event we're about to append is an - ascii keystroke since we're processing a - keymap table. */ - if (is_metized) - { - int meta_bit = meta_modifier; - Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1); - tem = Fcopy_sequence (thisseq); - - Faset (tem, last, make_number (XINT (index) | meta_bit)); - - /* This new sequence is the same length as - thisseq, so stick it in the list right - after this one. */ - XCDR (tail) - = Fcons (Fcons (tem, cmd), XCDR (tail)); - } - else - { - tem = append_key (thisseq, index); - nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); - } - } - } -} Lisp_Object Qsingle_key_description, Qkey_description; @@ -2235,7 +2227,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect) } - for (; ! NILP (sequences); sequences = XCDR (sequences)) + for (; !NILP (sequences); sequences = XCDR (sequences)) { Lisp_Object sequence; @@ -2264,7 +2256,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect) we find. */ if (EQ (firstonly, Qnon_ascii)) RETURN_UNGCPRO (sequence); - else if (! NILP (firstonly) && ascii_sequence_p (sequence)) + else if (!NILP (firstonly) && ascii_sequence_p (sequence)) RETURN_UNGCPRO (sequence); } } @@ -2277,7 +2269,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect) /* firstonly may have been t, but we may have gone all the way through the keymaps without finding an all-ASCII key sequence. So just return the best we could find. */ - if (! NILP (firstonly)) + if (!NILP (firstonly)) return Fcar (found); return found; @@ -2311,16 +2303,10 @@ indirect definition itself.") /* Find the relevant keymaps. */ if (CONSP (keymap) && KEYMAPP (XCAR (keymap))) keymaps = keymap; - else if (! NILP (keymap)) + else if (!NILP (keymap)) keymaps = Fcons (keymap, Fcons (current_global_map, Qnil)); else - keymaps = - Fdelq (Qnil, - nconc2 (Fcurrent_minor_mode_maps (), - Fcons (get_local_map (PT, current_buffer, Qkeymap), - Fcons (get_local_map (PT, current_buffer, - Qlocal_map), - Fcons (current_global_map, Qnil))))); + keymaps = Fcurrent_active_maps (Qnil); /* Only use caching for the menubar (i.e. called with (def nil t nil). We don't really need to check `keymap'. */ @@ -2488,14 +2474,19 @@ then we display only bindings that start with that prefix.") return Qnil; } -/* ARG is (BUFFER PREFIX MENU-FLAG). */ - -static Lisp_Object -describe_buffer_bindings (arg) - Lisp_Object arg; +DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0, + "Insert the list of all defined keys and their definitions.\n\ +The list is inserted in the current buffer, while the bindings are\n\ +looked up in BUFFER.\n\ +The optional argument PREFIX, if non-nil, should be a key sequence;\n\ +then we display only bindings that start with that prefix.\n\ +The optional argument MENUS, if non-nil, says to mention menu bindings.\n\ +\(Ordinarily these are omitted from the output.)") + (buffer, prefix, menus) + Lisp_Object buffer, prefix, menus; { - Lisp_Object descbuf, prefix, shadow; - int nomenu; + Lisp_Object outbuf, shadow; + int nomenu = NILP (menus); register Lisp_Object start1; struct gcpro gcpro1; @@ -2505,16 +2496,10 @@ 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)); - shadow = Qnil; GCPRO1 (shadow); - Fset_buffer (Vstandard_output); + outbuf = Fcurrent_buffer(); /* Report on alternates for keys. */ if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix)) @@ -2555,16 +2540,16 @@ You type Translation\n\ int i, nmaps; Lisp_Object *modes, *maps; - /* Temporarily switch to descbuf, so that we can get that buffer's + /* Temporarily switch to `buffer', so that we can get that buffer's minor modes correctly. */ - Fset_buffer (descbuf); + Fset_buffer (buffer); if (!NILP (current_kboard->Voverriding_terminal_local_map) || !NILP (Voverriding_local_map)) nmaps = 0; else nmaps = current_minor_maps (&modes, &maps); - Fset_buffer (Vstandard_output); + Fset_buffer (outbuf); /* Print the minor mode maps. */ for (i = 0; i < nmaps; i++) @@ -2601,7 +2586,7 @@ You type Translation\n\ else if (!NILP (Voverriding_local_map)) start1 = Voverriding_local_map; else - start1 = XBUFFER (descbuf)->keymap; + start1 = XBUFFER (buffer)->keymap; if (!NILP (start1)) { @@ -2618,12 +2603,22 @@ You type Translation\n\ describe_map_tree (Vfunction_key_map, 0, Qnil, prefix, "\f\nFunction key map translations", nomenu, 1, 0); - call0 (intern ("help-mode")); - Fset_buffer (descbuf); UNGCPRO; return Qnil; } +/* ARG is (BUFFER PREFIX MENU-FLAG). */ + +static Lisp_Object +describe_buffer_bindings (arg) + Lisp_Object arg; +{ + Fset_buffer (Vstandard_output); + return Fdescribe_buffer_bindings (XCAR (arg), XCAR (XCDR (arg)), + XCAR (XCDR (XCDR (arg)))); +} + + /* Insert a description of the key bindings in STARTMAP, followed by those of all maps reachable through STARTMAP. If PARTIAL is nonzero, omit certain "uninteresting" commands @@ -2741,11 +2736,11 @@ key binding\n\ } /* Maps we have already listed in this loop shadow this map. */ - for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail)) + for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail)) { Lisp_Object tem; tem = Fequal (Fcar (XCAR (tail)), prefix); - if (! NILP (tem)) + if (!NILP (tem)) sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows); } @@ -2885,7 +2880,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) /* Ignore bindings whose "keys" are not really valid events. (We get these in the frames and buffers menu.) */ - if (! (SYMBOLP (event) || INTEGERP (event))) + if (!(SYMBOLP (event) || INTEGERP (event))) continue; if (nomenu && EQ (event, Qmenu_bar)) @@ -2913,7 +2908,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) } tem = Flookup_key (map, kludge, Qt); - if (! EQ (tem, definition)) continue; + if (!EQ (tem, definition)) continue; if (first) { @@ -3155,7 +3150,7 @@ describe_vector (vector, elt_prefix, elt_describer, ASET (kludge, 0, make_number (character)); tem = Flookup_key (entire_map, kludge, Qt); - if (! EQ (tem, definition)) + if (!EQ (tem, definition)) continue; } @@ -3456,6 +3451,7 @@ and applies even for keys that have ordinary bindings."); defsubr (&Skeymapp); defsubr (&Skeymap_parent); + defsubr (&Skeymap_prompt); defsubr (&Sset_keymap_parent); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); @@ -3472,6 +3468,7 @@ and applies even for keys that have ordinary bindings."); defsubr (&Scurrent_local_map); defsubr (&Scurrent_global_map); defsubr (&Scurrent_minor_mode_maps); + defsubr (&Scurrent_active_maps); defsubr (&Saccessible_keymaps); defsubr (&Skey_description); defsubr (&Sdescribe_vector); @@ -3479,6 +3476,7 @@ and applies even for keys that have ordinary bindings."); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); defsubr (&Sdescribe_bindings_internal); + defsubr (&Sdescribe_buffer_bindings); defsubr (&Sapropos_internal); } -- 2.39.2