X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b31a42188c124748f03d73837c59949cd72083ba..645280b72c54063bedc239469f013dd1749f689d:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index d2f232c78e..88f89cdf72 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -15,7 +15,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ #include @@ -179,7 +180,7 @@ synkey (frommap, fromchar, tomap, tochar) #endif /* 0 */ DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, - "Return t if ARG is a keymap.\n\ + "Return t if OBJECT is a keymap.\n\ \n\ A keymap is a list (keymap . ALIST),\n\ or a symbol whose function definition is itself a keymap.\n\ @@ -257,8 +258,141 @@ get_keymap (object) { return get_keymap_1 (object, 1, 0); } + +/* Return the parent map of the keymap MAP, or nil if it has none. + We assume that MAP is a valid keymap. */ + +DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0, + "Return the parent keymap of KEYMAP.") + (keymap) + Lisp_Object keymap; +{ + Lisp_Object list; + + keymap = get_keymap_1 (keymap, 1, 1); + + /* Skip past the initial element `keymap'. */ + list = XCONS (keymap)->cdr; + for (; CONSP (list); list = XCONS (list)->cdr) + { + /* See if there is another `keymap'. */ + if (EQ (Qkeymap, XCONS (list)->car)) + 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, + "Modify KEYMAP to set its parent map to PARENT.\n\ +PARENT should be nil or another keymap.") + (keymap, parent) + Lisp_Object keymap, parent; +{ + Lisp_Object list, prev; + int i; + + keymap = get_keymap_1 (keymap, 1, 1); + if (!NILP (parent)) + parent = get_keymap_1 (parent, 1, 1); + + /* Skip past the initial element `keymap'. */ + prev = keymap; + while (1) + { + list = XCONS (prev)->cdr; + /* 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 we already have the right parent, return now + so that we avoid the loops below. */ + if (EQ (XCONS (prev)->cdr, parent)) + return parent; + + XCONS (prev)->cdr = parent; + break; + } + prev = list; + } + + /* Scan through for submaps, and set their parents too. */ + + for (list = XCONS (keymap)->cdr; CONSP (list); list = XCONS (list)->cdr) + { + /* Stop the scan when we come to the parent. */ + if (EQ (XCONS (list)->car, 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])) + fix_submap_inheritance (keymap, make_number (i), + XVECTOR (XCONS (list)->car)->contents[i]); + } + + return 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. */ + +fix_submap_inheritance (map, event, submap) + Lisp_Object map, event, submap; +{ + Lisp_Object map_parent, parent_entry; + + /* 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)) + { + Lisp_Object carcar; + carcar = XCONS (XCONS (submap)->car)->car; + if (NILP (carcar) || VECTORP (carcar)) + submap = XCONS (submap)->cdr; + } + } + + /* If it isn't a keymap now, there's no work to do. */ + if (! CONSP (submap) + || ! EQ (XCONS (submap)->car, Qkeymap)) + return; + + map_parent = Fkeymap_parent (map); + if (! NILP (map_parent)) + parent_entry = access_keymap (map_parent, event, 0, 0); + else + parent_entry = Qnil; + /* 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))) + parent_entry = Qnil; + + if (! EQ (parent_entry, submap)) + Fset_keymap_parent (submap, parent_entry); +} + /* Look up IDX in MAP. IDX may be any sort of event. Note that this does only one level of lookup; IDX must be a single event, not a sequence. @@ -319,6 +453,8 @@ access_keymap (map, idx, t_ok, noinherit) val = XCONS (binding)->cdr; if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; + if (CONSP (val)) + fix_submap_inheritance (map, idx, val); return val; } if (t_ok && EQ (XCONS (binding)->car, Qt)) @@ -331,6 +467,8 @@ access_keymap (map, idx, t_ok, noinherit) val = XVECTOR (binding)->contents[XFASTINT (idx)]; if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; + if (CONSP (val)) + fix_submap_inheritance (map, idx, val); return val; } } @@ -758,6 +896,20 @@ define_as_prefix (keymap, c) make it a prefix in this map, and make its definition inherit the other prefix definition. */ inherit = access_keymap (keymap, c, 0, 0); +#if 0 + /* This code is needed to do the right thing in the following case: + keymap A inherits from B, + you define KEY as a prefix in A, + then later you define KEY as a prefix in B. + We want the old prefix definition in A to inherit from that in B. + It is hard to do that retroactively, so this code + creates the prefix in B right away. + + But it turns out that this code causes problems immediately + when the prefix in A is defined: it causes B to define KEY + as a prefix with no subcommands. + + So I took out this code. */ if (NILP (inherit)) { /* If there's an inherited keymap @@ -772,6 +924,7 @@ define_as_prefix (keymap, c) if (!NILP (tail)) inherit = define_as_prefix (tail, c); } +#endif cmd = nconc2 (cmd, inherit); store_in_keymap (keymap, c, cmd); @@ -1050,17 +1203,17 @@ 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.") - (name, mapvar) - Lisp_Object name, mapvar; + (command, mapvar) + Lisp_Object command, mapvar; { Lisp_Object map; map = Fmake_sparse_keymap (Qnil); - Ffset (name, map); + Ffset (command, map); if (!NILP (mapvar)) Fset (mapvar, map); else - Fset (name, map); - return name; + Fset (command, map); + return command; } DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, @@ -1070,7 +1223,6 @@ DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, { keymap = get_keymap (keymap); current_global_map = keymap; - record_asynch_buffer_change (); return Qnil; } @@ -1085,7 +1237,6 @@ If KEYMAP is nil, that means no local keymap.") keymap = get_keymap (keymap); current_buffer->keymap = keymap; - record_asynch_buffer_change (); return Qnil; } @@ -1123,11 +1274,11 @@ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, "Find all keymaps accessible via prefix characters from KEYMAP.\n\ Returns a list of elements of the form (KEYS . MAP), where the sequence\n\ KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\ -so that the KEYS increase in length. The first element is (\"\" . KEYMAP).\n\ +so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\ An optional argument PREFIX, if non-nil, should be a key sequence;\n\ then the value includes only maps for prefixes that start with PREFIX.") - (startmap, prefix) - Lisp_Object startmap, prefix; + (keymap, prefix) + Lisp_Object keymap, prefix; { Lisp_Object maps, good_maps, tail; int prefixlen = 0; @@ -1142,7 +1293,7 @@ then the value includes only maps for prefixes that start with PREFIX.") /* If a prefix was specified, start with the keymap (if any) for that prefix, so we don't waste time considering other prefixes. */ Lisp_Object tem; - tem = Flookup_key (startmap, prefix, Qt); + tem = Flookup_key (keymap, prefix, Qt); /* Flookup_key may give us nil, or a number, if the prefix is not defined in this particular map. It might even give us a list that isn't a keymap. */ @@ -1154,7 +1305,7 @@ then the value includes only maps for prefixes that start with PREFIX.") } else maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil), - get_keymap (startmap)), + get_keymap (keymap)), Qnil); /* For each map in the list maps, @@ -1519,16 +1670,16 @@ push_text_char_description (c, p) /* This function cannot GC. */ DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0, - "Return a pretty description of file-character CHAR.\n\ + "Return a pretty description of file-character CHARACTER.\n\ Control characters turn into \"^char\", etc.") - (chr) - Lisp_Object chr; + (character) + Lisp_Object character; { char tem[6]; - CHECK_NUMBER (chr, 0); + CHECK_NUMBER (character, 0); - *push_text_char_description (XINT (chr) & 0377, tem) = 0; + *push_text_char_description (XINT (character) & 0377, tem) = 0; return build_string (tem); } @@ -2069,7 +2220,7 @@ key binding\n\ describe_map (Fcdr (elt), Fcar (elt), transl ? describe_translation : describe_command, - partial, sub_shadows, &seen); + partial, sub_shadows, &seen, nomenu); skip: ; } @@ -2080,13 +2231,30 @@ key binding\n\ UNGCPRO; } +static int previous_description_column; + static void describe_command (definition) Lisp_Object definition; { register Lisp_Object tem1; + int column = current_column (); + int description_column; - Findent_to (make_number (16), make_number (1)); + /* If column 16 is no good, go to col 32; + but don't push beyond that--go to next line instead. */ + if (column > 30) + { + insert_char ('\n'); + description_column = 32; + } + else if (column > 14 || (column > 10 && previous_description_column == 32)) + description_column = 32; + else + description_column = 16; + + Findent_to (make_number (description_column), make_number (1)); + previous_description_column = description_column; if (SYMBOLP (definition)) { @@ -2155,16 +2323,17 @@ shadow_lookup (shadow, key, flag) /* Describe the contents of map MAP, assuming that this map itself is reached by the sequence of prefix keys KEYS (a string or vector). - PARTIAL, SHADOW are as in `describe_map_tree' above. */ + PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ static void -describe_map (map, keys, elt_describer, partial, shadow, seen) +describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu) register Lisp_Object map; Lisp_Object keys; int (*elt_describer) (); int partial; Lisp_Object shadow; Lisp_Object *seen; + int nomenu; { Lisp_Object elt_prefix; Lisp_Object tail, definition, event; @@ -2210,6 +2379,9 @@ describe_map (map, keys, elt_describer, partial, shadow, seen) if (! (SYMBOLP (event) || INTEGERP (event))) continue; + if (nomenu && EQ (event, Qmenu_bar)) + continue; + definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0); /* Don't show undefined commands or suppressed commands. */ @@ -2236,6 +2408,7 @@ describe_map (map, keys, elt_describer, partial, shadow, seen) if (first) { + previous_description_column = 0; insert ("\n", 1); first = 0; } @@ -2515,18 +2688,18 @@ apropos_accum (symbol, string) DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0, "Show all symbols whose names contain match for REGEXP.\n\ -If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\ +If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\ for each symbol and a symbol is mentioned only if that returns non-nil.\n\ Return list of symbols found.") - (string, pred) - Lisp_Object string, pred; + (regexp, predicate) + Lisp_Object regexp, predicate; { struct gcpro gcpro1, gcpro2; - CHECK_STRING (string, 0); - apropos_predicate = pred; + CHECK_STRING (regexp, 0); + apropos_predicate = predicate; GCPRO2 (apropos_predicate, apropos_accumulate); apropos_accumulate = Qnil; - map_obarray (Vobarray, apropos_accum, string); + map_obarray (Vobarray, apropos_accum, regexp); apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp); UNGCPRO; return apropos_accumulate; @@ -2627,6 +2800,8 @@ and applies even for keys that have ordinary bindings."); staticpro (&Qnon_ascii); defsubr (&Skeymapp); + defsubr (&Skeymap_parent); + defsubr (&Sset_keymap_parent); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); defsubr (&Scopy_keymap);