X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9fc722dee15cb7544a9920f521911a35e6aa4700..c7dd82a34d3b058a81d11823a7f730f6607bd43d:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 1c403dcf23..abceaa5030 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -87,7 +87,6 @@ static Lisp_Object define_as_prefix (); static Lisp_Object describe_buffer_bindings (); static void describe_command (); static void describe_map (); -static void describe_map_2 (); /* Keymap object support - constructors and predicates. */ @@ -164,8 +163,8 @@ synkey (frommap, fromchar, tomap, tochar) int fromchar, tochar; { Lisp_Object v, c; - XSET (v, Lisp_Vector, tomap); - XFASTINT (c) = tochar; + XSETVECTOR (v, tomap); + XSETFASTINT (c, tochar); frommap->contents[fromchar] = Fcons (v, c); } #endif /* 0 */ @@ -189,6 +188,7 @@ is also allowed as an element.") If AUTOLOAD is non-zero and OBJECT is a symbol whose function value is an autoload form, do the autoload and try again. + If AUTOLOAD is nonzero, callers must assume GC is possible. ERROR controls how we respond if OBJECT isn't a keymap. If ERROR is non-zero, signal an error; otherwise, just return Qnil. @@ -214,7 +214,7 @@ get_keymap_1 (object, error, autoload) /* Should we do an autoload? Autoload forms for keymaps have Qkeymap as their fifth element. */ if (autoload - && XTYPE (object) == Lisp_Symbol + && SYMBOLP (object) && CONSP (tem) && EQ (XCONS (tem)->car, Qautoload)) { @@ -246,7 +246,7 @@ Lisp_Object get_keymap (object) Lisp_Object object; { - return get_keymap_1 (object, 0, 0); + return get_keymap_1 (object, 1, 0); } @@ -279,12 +279,12 @@ access_keymap (map, idx, t_ok, noinherit) /* If idx is a symbol, it might have modifiers, which need to be put in the canonical order. */ - if (XTYPE (idx) == Lisp_Symbol) + if (SYMBOLP (idx)) idx = reorder_modifiers (idx); else if (INTEGERP (idx)) /* Clobber the high bits that can be present on a machine with more than 24 bits of integer. */ - XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1)); + XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); { Lisp_Object tail; @@ -296,16 +296,15 @@ access_keymap (map, idx, t_ok, noinherit) Lisp_Object binding; binding = XCONS (tail)->car; - switch (XTYPE (binding)) + if (SYMBOLP (binding)) { - case Lisp_Symbol: /* If NOINHERIT, stop finding prefix definitions after we pass a second occurrence of the `keymap' symbol. */ if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map)) noprefix = 1; - break; - - case Lisp_Cons: + } + else if (CONSP (binding)) + { if (EQ (XCONS (binding)->car, idx)) { val = XCONS (binding)->cdr; @@ -315,19 +314,16 @@ access_keymap (map, idx, t_ok, noinherit) } if (t_ok && EQ (XCONS (binding)->car, Qt)) t_binding = XCONS (binding)->cdr; - break; - - case Lisp_Vector: - if (XTYPE (idx) == Lisp_Int - && XINT (idx) >= 0 - && XINT (idx) < XVECTOR (binding)->size) + } + else if (VECTORP (binding)) + { + if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size) { - val = XVECTOR (binding)->contents[XINT (idx)]; + val = XVECTOR (binding)->contents[XFASTINT (idx)]; if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; return val; } - break; } QUIT; @@ -344,18 +340,22 @@ access_keymap (map, idx, t_ok, noinherit) 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. */ + remove that. Also remove a menu help string as second element. + + If AUTOLOAD is nonzero, load autoloadable keymaps + that are referred to with indirection. */ Lisp_Object -get_keyelt (object) +get_keyelt (object, autoload) register Lisp_Object object; + int autoload; { while (1) { register Lisp_Object map, tem; /* If the contents are (KEYMAP . ELEMENT), go indirect. */ - map = get_keymap_1 (Fcar_safe (object), 0, 0); + map = get_keymap_1 (Fcar_safe (object), 0, autoload); tem = Fkeymapp (map); if (!NILP (tem)) object = access_keymap (map, Fcdr (object), 0, 0); @@ -364,14 +364,13 @@ get_keyelt (object) use DEFN. Keymap alist elements like (CHAR MENUSTRING . DEFN) will be used by HierarKey menus. */ - else if (XTYPE (object) == Lisp_Cons - && XTYPE (XCONS (object)->car) == Lisp_String) + else if (CONSP (object) + && STRINGP (XCONS (object)->car)) { object = XCONS (object)->cdr; /* Also remove a menu help string, if any, following the menu item name. */ - if (XTYPE (object) == Lisp_Cons - && XTYPE (XCONS (object)->car) == Lisp_String) + if (CONSP (object) && STRINGP (XCONS (object)->car)) object = XCONS (object)->cdr; /* Also remove the sublist that caches key equivalences, if any. */ if (CONSP (object) @@ -396,8 +395,13 @@ store_in_keymap (keymap, idx, def) register Lisp_Object idx; register Lisp_Object def; { - if (XTYPE (keymap) != Lisp_Cons - || ! EQ (XCONS (keymap)->car, Qkeymap)) + /* 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 (!NILP (Vpurify_flag) && CONSP (def) + && STRINGP (XCONS (def)->car)) + def = Fcons (XCONS (def)->car, XCONS (def)->cdr); + + if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap)) error ("attempt to define a key in a non-keymap"); /* If idx is a list (some sort of mouse click, perhaps?), @@ -407,12 +411,12 @@ store_in_keymap (keymap, idx, def) /* If idx is a symbol, it might have modifiers, which need to be put in the canonical order. */ - if (XTYPE (idx) == Lisp_Symbol) + if (SYMBOLP (idx)) idx = reorder_modifiers (idx); else if (INTEGERP (idx)) /* Clobber the high bits that can be present on a machine with more than 24 bits of integer. */ - XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1)); + XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); /* Scan the keymap for a binding of idx. */ { @@ -432,34 +436,31 @@ store_in_keymap (keymap, idx, def) Lisp_Object elt; elt = XCONS (tail)->car; - switch (XTYPE (elt)) + if (VECTORP (elt)) { - case Lisp_Vector: - if (XTYPE (idx) == Lisp_Int - && XINT (idx) >= 0 && XINT (idx) < XVECTOR (elt)->size) + if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (elt)->size) { XVECTOR (elt)->contents[XFASTINT (idx)] = def; return def; } insertion_point = tail; - break; - - case Lisp_Cons: + } + else if (CONSP (elt)) + { if (EQ (idx, XCONS (elt)->car)) { XCONS (elt)->cdr = def; return def; } - break; - - case Lisp_Symbol: + } + else if (SYMBOLP (elt)) + { /* If we find a 'keymap' symbol in the spine of KEYMAP, then we must have found the start of a second keymap being used as the tail of KEYMAP, and a binding for IDX should be inserted before it. */ if (EQ (elt, Qkeymap)) goto keymap_end; - break; } QUIT; @@ -468,8 +469,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); + XCONS (insertion_point)->cdr + = Fcons (Fcons (idx, def), XCONS (insertion_point)->cdr); } return def; @@ -495,7 +496,7 @@ is not copied.") Lisp_Object elt; elt = XCONS (tail)->car; - if (XTYPE (elt) == Lisp_Vector) + if (VECTORP (elt)) { int i; @@ -503,7 +504,7 @@ is not copied.") XCONS (tail)->car = elt; for (i = 0; i < XVECTOR (elt)->size; i++) - if (XTYPE (XVECTOR (elt)->contents[i]) != Lisp_Symbol + if (!SYMBOLP (XVECTOR (elt)->contents[i]) && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i]))) XVECTOR (elt)->contents[i] = Fcopy_keymap (XVECTOR (elt)->contents[i]); @@ -549,6 +550,8 @@ is not copied.") /* Simple Keymap mutators and accessors. */ +/* GC is possible in this function if it autoloads a keymap. */ + DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\ KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\ @@ -583,10 +586,9 @@ the front of KEYMAP.") int length; struct gcpro gcpro1, gcpro2, gcpro3; - keymap = get_keymap (keymap); + keymap = get_keymap_1 (keymap, 1, 1); - if (XTYPE (key) != Lisp_Vector - && XTYPE (key) != Lisp_String) + if (!VECTORP (key) && !STRINGP (key)) key = wrong_type_argument (Qarrayp, key); length = XFASTINT (Flength (key)); @@ -595,7 +597,7 @@ the front of KEYMAP.") GCPRO3 (keymap, key, def); - if (XTYPE (key) == Lisp_Vector) + if (VECTORP (key)) meta_bit = meta_modifier; else meta_bit = 0x80; @@ -605,7 +607,10 @@ the front of KEYMAP.") { c = Faref (key, make_number (idx)); - if (XTYPE (c) == Lisp_Int + if (CONSP (c) && lucid_event_type_list_p (c)) + c = convert_event_type_list (c); + + if (INTEGERP (c) && (XINT (c) & meta_bit) && !metized) { @@ -614,7 +619,7 @@ the front of KEYMAP.") } else { - if (XTYPE (c) == Lisp_Int) + if (INTEGERP (c)) XSETINT (c, XINT (c) & ~meta_bit); metized = 0; @@ -622,12 +627,12 @@ the front of KEYMAP.") } if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c)) - error ("Key sequence contains illegal events"); + error ("Key sequence contains invalid events"); if (idx == length) RETURN_UNGCPRO (store_in_keymap (keymap, c, def)); - cmd = get_keyelt (access_keymap (keymap, c, 0, 1)); + cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1); /* If this key is undefined, make it a prefix. */ if (NILP (cmd)) @@ -643,6 +648,7 @@ the front of KEYMAP.") } /* Value is number if KEY is too long; NIL if valid but has no definition. */ +/* GC is possible in this function if it autoloads a keymap. */ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\ @@ -672,28 +678,33 @@ recognize the default bindings, just as `read-key-sequence' does.") int length; int t_ok = ! NILP (accept_default); int meta_bit; + struct gcpro gcpro1; - keymap = get_keymap (keymap); + keymap = get_keymap_1 (keymap, 1, 1); - if (XTYPE (key) != Lisp_Vector - && XTYPE (key) != Lisp_String) + if (!VECTORP (key) && !STRINGP (key)) key = wrong_type_argument (Qarrayp, key); length = XFASTINT (Flength (key)); if (length == 0) return keymap; - if (XTYPE (key) == Lisp_Vector) + if (VECTORP (key)) meta_bit = meta_modifier; else meta_bit = 0x80; + GCPRO1 (key); + idx = 0; while (1) { c = Faref (key, make_number (idx)); - if (XTYPE (c) == Lisp_Int + if (CONSP (c) && lucid_event_type_list_p (c)) + c = convert_event_type_list (c); + + if (INTEGERP (c) && (XINT (c) & meta_bit) && !metized) { @@ -702,20 +713,20 @@ recognize the default bindings, just as `read-key-sequence' does.") } else { - if (XTYPE (c) == Lisp_Int) + if (INTEGERP (c)) XSETINT (c, XINT (c) & ~meta_bit); metized = 0; idx++; } - cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0)); + cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1); if (idx == length) - return cmd; + RETURN_UNGCPRO (cmd); - keymap = get_keymap_1 (cmd, 0, 0); + keymap = get_keymap_1 (cmd, 0, 1); if (NILP (keymap)) - return make_number (idx); + RETURN_UNGCPRO (make_number (idx)); QUIT; } @@ -806,9 +817,9 @@ current_minor_maps (modeptr, mapptr) for (alist = Vminor_mode_map_alist; CONSP (alist); alist = XCONS (alist)->cdr) - if (CONSP (assoc = XCONS (alist)->car) - && XTYPE (var = XCONS (assoc)->car) == Lisp_Symbol - && ! EQ ((val = find_symbol_value (var)), Qunbound) + if ((assoc = XCONS (alist)->car, CONSP (assoc)) + && (var = XCONS (assoc)->car, SYMBOLP (var)) + && (val = find_symbol_value (var), ! EQ (val, Qunbound)) && ! NILP (val)) { if (i >= cmm_size) @@ -856,6 +867,8 @@ current_minor_maps (modeptr, mapptr) return i; } +/* GC is possible in this function if it autoloads a keymap. */ + DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0, "Return the binding for command KEY in current keymaps.\n\ KEY is a string or vector, a sequence of keystrokes.\n\ @@ -867,43 +880,52 @@ usable as a general function for probing keymaps. However, if the\n\ optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\ recognize the default bindings, just as `read-key-sequence' does.") (key, accept_default) - Lisp_Object key; + Lisp_Object key, accept_default; { Lisp_Object *maps, value; int nmaps, i; + struct gcpro gcpro1; + + GCPRO1 (key); if (!NILP (Voverriding_local_map)) { value = Flookup_key (Voverriding_local_map, key, accept_default); - if (! NILP (value) && XTYPE (value) != Lisp_Int) - return value; + if (! NILP (value) && !INTEGERP (value)) + RETURN_UNGCPRO (value); } else { nmaps = current_minor_maps (0, &maps); + /* Note that all these maps are GCPRO'd + in the places where we found them. */ + for (i = 0; i < nmaps; i++) if (! NILP (maps[i])) { value = Flookup_key (maps[i], key, accept_default); - if (! NILP (value) && XTYPE (value) != Lisp_Int) - return value; + if (! NILP (value) && !INTEGERP (value)) + RETURN_UNGCPRO (value); } if (! NILP (current_buffer->keymap)) { value = Flookup_key (current_buffer->keymap, key, accept_default); - if (! NILP (value) && XTYPE (value) != Lisp_Int) - return value; + if (! NILP (value) && !INTEGERP (value)) + RETURN_UNGCPRO (value); } } value = Flookup_key (current_global_map, key, accept_default); - if (! NILP (value) && XTYPE (value) != Lisp_Int) + UNGCPRO; + if (! NILP (value) && !INTEGERP (value)) return value; return Qnil; } +/* GC is possible in this function if it autoloads a keymap. */ + DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0, "Return the binding for command KEYS in current local keymap only.\n\ KEYS is a string, a sequence of keystrokes.\n\ @@ -921,12 +943,14 @@ bindings; see the description of `lookup-key' for more details about this.") return Flookup_key (map, keys, accept_default); } +/* GC is possible in this function if it autoloads a keymap. */ + DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0, "Return the binding for command KEYS in current global keymap only.\n\ KEYS is a string, a sequence of keystrokes.\n\ The binding is probably a symbol with a function definition.\n\ This function's return values are the same as those of lookup-key\n\ -(which see).\n\ +\(which see).\n\ \n\ If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\ bindings; see the description of `lookup-key' for more details about this.") @@ -936,6 +960,8 @@ bindings; see the description of `lookup-key' for more details about this.") return Flookup_key (current_global_map, keys, accept_default); } +/* GC is possible in this function if it autoloads a keymap. */ + DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0, "Find the visible minor mode bindings of KEY.\n\ Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\ @@ -955,93 +981,30 @@ bindings; see the description of `lookup-key' for more details about this.") int nmaps; Lisp_Object binding; int i, j; + struct gcpro gcpro1, gcpro2; nmaps = current_minor_maps (&modes, &maps); + /* Note that all these maps are GCPRO'd + in the places where we found them. */ + + binding = Qnil; + GCPRO2 (key, binding); for (i = j = 0; i < nmaps; i++) if (! NILP (maps[i]) && ! NILP (binding = Flookup_key (maps[i], key, accept_default)) - && XTYPE (binding) != Lisp_Int) + && !INTEGERP (binding)) { if (! NILP (get_keymap (binding))) maps[j++] = Fcons (modes[i], binding); else if (j == 0) - return Fcons (Fcons (modes[i], binding), Qnil); + RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil)); } + UNGCPRO; return Flist (j, maps); } -DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2, - "kSet key globally: \nCSet key %s to command: ", - "Give KEY a global binding as COMMAND.\n\ -COMMAND is a symbol naming an interactively-callable function.\n\ -KEY is a key sequence (a string or vector of characters or event types).\n\ -Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ -can be included if you use a vector.\n\ -Note that if KEY has a local binding in the current buffer\n\ -that local binding will continue to shadow any global binding.") - (keys, function) - Lisp_Object keys, function; -{ - if (XTYPE (keys) != Lisp_Vector - && XTYPE (keys) != Lisp_String) - keys = wrong_type_argument (Qarrayp, keys); - - Fdefine_key (current_global_map, keys, function); - return Qnil; -} - -DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2, - "kSet key locally: \nCSet key %s locally to command: ", - "Give KEY a local binding as COMMAND.\n\ -COMMAND is a symbol naming an interactively-callable function.\n\ -KEY is a key sequence (a string or vector of characters or event types).\n\ -Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ -can be included if you use a vector.\n\ -The binding goes in the current buffer's local map,\n\ -which in most cases is shared with all other buffers in the same major mode.") - (keys, function) - Lisp_Object keys, function; -{ - register Lisp_Object map; - map = current_buffer->keymap; - if (NILP (map)) - { - map = Fmake_sparse_keymap (Qnil); - current_buffer->keymap = map; - } - - if (XTYPE (keys) != Lisp_Vector - && XTYPE (keys) != Lisp_String) - keys = wrong_type_argument (Qarrayp, keys); - - Fdefine_key (map, keys, function); - return Qnil; -} - -DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key, - 1, 1, "kUnset key globally: ", - "Remove global binding of KEY.\n\ -KEY is a string representing a sequence of keystrokes.") - (keys) - Lisp_Object keys; -{ - return Fglobal_set_key (keys, Qnil); -} - -DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1, - "kUnset key locally: ", - "Remove local binding of KEY.\n\ -KEY is a string representing a sequence of keystrokes.") - (keys) - Lisp_Object keys; -{ - if (!NILP (current_buffer->keymap)) - Flocal_set_key (keys, Qnil); - return Qnil; -} - DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 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\ @@ -1068,6 +1031,8 @@ 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; } @@ -1081,6 +1046,7 @@ If KEYMAP is nil, that means no local keymap.") keymap = get_keymap (keymap); current_buffer->keymap = keymap; + record_asynch_buffer_change (); return Qnil; } @@ -1111,6 +1077,8 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_ /* Help functions for describing and documenting keymaps. */ +/* This function cannot GC. */ + DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, 1, 2, 0, "Find all keymaps accessible via prefix characters from KEYMAP.\n\ @@ -1125,12 +1093,30 @@ then the value includes only maps for prefixes that start with PREFIX.") Lisp_Object maps, good_maps, tail; int prefixlen = 0; + /* no need for gcpro because we don't autoload any keymaps. */ + if (!NILP (prefix)) prefixlen = XINT (Flength (prefix)); - maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil), - get_keymap (startmap)), - Qnil); + if (!NILP (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); + /* 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. */ + tem = get_keymap_1 (tem, 0, 0); + if (!NILP (tem)) + maps = Fcons (Fcons (prefix, tem), Qnil); + else + return Qnil; + } + else + maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil), + get_keymap (startmap)), + Qnil); /* For each map in the list maps, look at any other maps it points to, @@ -1160,7 +1146,7 @@ then the value includes only maps for prefixes that start with PREFIX.") QUIT; - if (XTYPE (elt) == Lisp_Vector) + if (VECTORP (elt)) { register int i; @@ -1170,7 +1156,7 @@ then the value includes only maps for prefixes that start with PREFIX.") register Lisp_Object tem; register Lisp_Object cmd; - cmd = get_keyelt (XVECTOR (elt)->contents[i]); + cmd = get_keyelt (XVECTOR (elt)->contents[i], 0); if (NILP (cmd)) continue; tem = Fkeymapp (cmd); if (!NILP (tem)) @@ -1211,7 +1197,7 @@ then the value includes only maps for prefixes that start with PREFIX.") { register Lisp_Object cmd, tem, filter; - cmd = get_keyelt (XCONS (elt)->cdr); + cmd = get_keyelt (XCONS (elt)->cdr, 0); /* Ignore definitions that aren't keymaps themselves. */ tem = Fkeymapp (cmd); if (!NILP (tem)) @@ -1227,7 +1213,7 @@ then the value includes only maps for prefixes that start with PREFIX.") /* 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 && XTYPE (elt) == Lisp_Int) + if (is_metized && INTEGERP (elt)) { tem = Fcopy_sequence (thisseq); Faset (tem, last, @@ -1268,7 +1254,7 @@ then the value includes only maps for prefixes that start with PREFIX.") for (i = 0; i < prefixlen; i++) { Lisp_Object i1; - XFASTINT (i1) = i; + XSETFASTINT (i1, i); if (!EQ (Faref (thisseq, i1), Faref (prefix, i1))) break; } @@ -1282,6 +1268,8 @@ then the value includes only maps for prefixes that start with PREFIX.") Lisp_Object Qsingle_key_description, Qkey_description; +/* This function cannot GC. */ + DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0, "Return a pretty description of key-sequence KEYS.\n\ Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\ @@ -1289,23 +1277,45 @@ spaces are put between sequence elements, etc.") (keys) Lisp_Object keys; { - if (XTYPE (keys) == Lisp_String) + int len; + int i; + Lisp_Object sep; + Lisp_Object *args; + + if (STRINGP (keys)) { Lisp_Object vector; - int i; vector = Fmake_vector (Flength (keys), Qnil); for (i = 0; i < XSTRING (keys)->size; i++) { if (XSTRING (keys)->data[i] & 0x80) - XFASTINT (XVECTOR (vector)->contents[i]) - = meta_modifier | (XSTRING (keys)->data[i] & ~0x80); + XSETFASTINT (XVECTOR (vector)->contents[i], + meta_modifier | (XSTRING (keys)->data[i] & ~0x80)); else - XFASTINT (XVECTOR (vector)->contents[i]) - = XSTRING (keys)->data[i]; + XSETFASTINT (XVECTOR (vector)->contents[i], + XSTRING (keys)->data[i]); } keys = vector; } - return Fmapconcat (Qsingle_key_description, keys, build_string (" ")); + 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. */ + + 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++) + { + args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]); + args[i * 2 + 1] = sep; + } + + return Fconcat (len * 2 - 1, args); } char * @@ -1416,6 +1426,8 @@ push_key_description (c, p) return p; } +/* This function cannot GC. */ + DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0, "Return a pretty description of command character KEY.\n\ Control characters turn into C-whatever, etc.") @@ -1426,18 +1438,17 @@ Control characters turn into C-whatever, etc.") key = EVENT_HEAD (key); - switch (XTYPE (key)) + if (INTEGERP (key)) /* Normal character */ { - case Lisp_Int: /* Normal character */ *push_key_description (XUINT (key), tem) = 0; return build_string (tem); - - case Lisp_Symbol: /* Function key or event-symbol */ - return Fsymbol_name (key); - - default: - error ("KEY must be an integer, cons, or symbol."); } + else if (SYMBOLP (key)) /* Function key or event-symbol */ + return Fsymbol_name (key); + else if (STRINGP (key)) /* Buffer names in the menubar. */ + return Fcopy_sequence (key); + else + error ("KEY must be an integer, cons, symbol, or string"); } char * @@ -1466,6 +1477,8 @@ push_text_char_description (c, p) return 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\ Control characters turn into \"^char\", etc.") @@ -1487,16 +1500,17 @@ static int ascii_sequence_p (seq) Lisp_Object seq; { - Lisp_Object i; + int i; int len = XINT (Flength (seq)); - for (XFASTINT (i) = 0; XFASTINT (i) < len; XFASTINT (i)++) + for (i = 0; i < len; i++) { - Lisp_Object elt; + Lisp_Object ii, elt; - elt = Faref (seq, i); + XSETFASTINT (ii, i); + elt = Faref (seq, ii); - if (XTYPE (elt) != Lisp_Int + if (!INTEGERP (elt) || (XUINT (elt) & ~CHAR_META) >= 0x80) return 0; } @@ -1507,6 +1521,8 @@ ascii_sequence_p (seq) /* where-is - finding a command in a set of keymaps. */ +/* This function can GC if Flookup_key autoloads any keymaps. */ + DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0, "Return list of keys that invoke DEFINITION.\n\ If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\ @@ -1514,10 +1530,10 @@ If KEYMAP is nil, search all the currently active keymaps.\n\ \n\ If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\ rather than a list of all possible key sequences.\n\ -If FIRSTONLY is t, avoid key sequences which use non-ASCII\n\ -keys and therefore may not be usable on ASCII terminals. If FIRSTONLY\n\ -is the symbol `non-ascii', return the first binding found, no matter\n\ -what its components.\n\ +If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\ +no matter what it is.\n\ +If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters, +and entirely reject menu bindings.\n\ \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\ @@ -1526,9 +1542,12 @@ indirect definition itself.") Lisp_Object definition, keymap; Lisp_Object firstonly, noindirect; { - register Lisp_Object maps; - Lisp_Object found; + Lisp_Object maps; + Lisp_Object found, sequence; int keymap_specified = !NILP (keymap); + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + /* 1 means ignore all menu bindings entirely. */ + int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); if (! keymap_specified) { @@ -1560,7 +1579,9 @@ indirect definition itself.") } } + GCPRO5 (definition, keymap, maps, found, sequence); found = Qnil; + sequence = Qnil; for (; !NILP (maps); maps = Fcdr (maps)) { @@ -1595,18 +1616,18 @@ indirect definition itself.") advance map to the next element until i indicates that we have finished off the vector. */ - Lisp_Object elt, key, binding, sequence; + Lisp_Object elt, key, binding; elt = XCONS (map)->car; QUIT; /* Set key and binding to the current key and binding, and advance map and i to the next binding. */ - if (XTYPE (elt) == Lisp_Vector) + if (VECTORP (elt)) { /* In a vector, look at each element. */ binding = XVECTOR (elt)->contents[i]; - XFASTINT (key) = i; + XSETFASTINT (key, i); i++; /* If we've just finished scanning a vector, advance map @@ -1635,12 +1656,33 @@ indirect definition itself.") /* Search through indirections unless that's not wanted. */ if (NILP (noindirect)) - binding = get_keyelt (binding); + { + if (nomenus) + { + while (1) + { + Lisp_Object map, tem; + /* If the contents are (KEYMAP . ELEMENT), go indirect. */ + map = get_keymap_1 (Fcar_safe (definition), 0, 0); + tem = Fkeymapp (map); + if (!NILP (tem)) + definition = access_keymap (map, Fcdr (definition), 0, 0); + else + break; + } + /* If the contents are (STRING ...), reject. */ + if (CONSP (definition) + && STRINGP (XCONS (definition)->car)) + continue; + } + else + binding = get_keyelt (binding, 0); + } /* End this iteration if this element does not match the target. */ - if (XTYPE (definition) == Lisp_Cons) + if (CONSP (definition)) { Lisp_Object tem; tem = Fequal (binding, definition); @@ -1653,7 +1695,7 @@ indirect definition itself.") /* We have found a match. Construct the key sequence where we found it. */ - if (XTYPE (key) == Lisp_Int && last_is_meta) + if (INTEGERP (key) && last_is_meta) { sequence = Fcopy_sequence (this); Faset (sequence, last, make_number (XINT (key) | meta_modifier)); @@ -1673,9 +1715,9 @@ indirect definition itself.") if (keymap_specified) { binding = Flookup_key (keymap, sequence, Qnil); - if (!NILP (binding) && XTYPE (binding) != Lisp_Int) + if (!NILP (binding) && !INTEGERP (binding)) { - if (XTYPE (definition) == Lisp_Cons) + if (CONSP (definition)) { Lisp_Object tem; tem = Fequal (binding, definition); @@ -1704,12 +1746,14 @@ indirect definition itself.") nil, then we should return the first ascii-only binding we find. */ if (EQ (firstonly, Qnon_ascii)) - return sequence; + RETURN_UNGCPRO (sequence); else if (! NILP (firstonly) && ascii_sequence_p (sequence)) - return sequence; + RETURN_UNGCPRO (sequence); } } + UNGCPRO; + found = Fnreverse (found); /* firstonly may have been t, but we may have gone all the way through @@ -1732,7 +1776,7 @@ then we display only bindings that start with that prefix.") Lisp_Object prefix; { register Lisp_Object thisbuf; - XSET (thisbuf, Lisp_Buffer, current_buffer); + XSETBUFFER (thisbuf, current_buffer); internal_with_output_to_temp_buffer ("*Help*", describe_buffer_bindings, Fcons (thisbuf, prefix)); @@ -1746,7 +1790,8 @@ describe_buffer_bindings (arg) Lisp_Object arg; { Lisp_Object descbuf, prefix, shadow; - register Lisp_Object start1, start2; + register Lisp_Object start1; + struct gcpro gcpro1; char *alternate_heading = "\ @@ -1757,11 +1802,12 @@ nominal alternate\n\ descbuf = XCONS (arg)->car; prefix = XCONS (arg)->cdr; shadow = Qnil; + GCPRO1 (shadow); Fset_buffer (Vstandard_output); /* Report on alternates for keys. */ - if (XTYPE (Vkeyboard_translate_table) == Lisp_String) + if (STRINGP (Vkeyboard_translate_table)) { int c; unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data; @@ -1807,28 +1853,23 @@ nominal alternate\n\ /* Print the minor mode maps. */ for (i = 0; i < nmaps; i++) { - /* Tht title for a minor mode keymap + /* The title for a minor mode keymap is constructed at run time. We let describe_map_tree do the actual insertion because it takes care of other features when doing so. */ - char *title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size); - char *p = title; - - if (XTYPE (modes[i]) == Lisp_Symbol) - { - *p++ = '`'; - bcopy (XSYMBOL (modes[i])->name->data, p, - XSYMBOL (modes[i])->name->size); - p += XSYMBOL (modes[i])->name->size; - *p++ = '\''; - } - else - { - bcopy ("Strangely Named", p, sizeof ("Strangely Named")); - p += sizeof ("Strangely Named"); - } - bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings")); - p += sizeof (" Minor Mode Bindings"); + char *title, *p; + + if (!SYMBOLP (modes[i])) + abort(); + + p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size); + *p++ = '`'; + bcopy (XSYMBOL (modes[i])->name->data, p, + XSYMBOL (modes[i])->name->size); + p += XSYMBOL (modes[i])->name->size; + *p++ = '\''; + bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1); + p += sizeof (" Minor Mode Bindings") - 1; *p = 0; describe_map_tree (maps[i], 0, shadow, prefix, title, 0); @@ -1852,7 +1893,9 @@ nominal alternate\n\ describe_map_tree (current_global_map, 0, shadow, prefix, "Global Bindings", 0); + call0 (intern ("help-mode")); Fset_buffer (descbuf); + UNGCPRO; return Qnil; } @@ -1874,8 +1917,8 @@ describe_map_tree (startmap, partial, shadow, prefix, title, nomenu) char *title; int nomenu; { - Lisp_Object maps; - struct gcpro gcpro1; + Lisp_Object maps, seen, sub_shadows; + struct gcpro gcpro1, gcpro2, gcpro3; int something = 0; char *key_heading = "\ @@ -1883,7 +1926,9 @@ key binding\n\ --- -------\n"; maps = Faccessible_keymaps (startmap, prefix); - GCPRO1 (maps); + seen = Qnil; + sub_shadows = Qnil; + GCPRO3 (maps, seen, sub_shadows); if (nomenu) { @@ -1923,7 +1968,7 @@ key binding\n\ for (; !NILP (maps); maps = Fcdr (maps)) { - register Lisp_Object elt, prefix, sub_shadows, tail; + register Lisp_Object elt, prefix, tail; elt = Fcar (maps); prefix = Fcar (elt); @@ -1938,18 +1983,16 @@ key binding\n\ /* If the sequence by which we reach this keymap is zero-length, then the shadow map for this keymap is just SHADOW. */ - if ((XTYPE (prefix) == Lisp_String - && XSTRING (prefix)->size == 0) - || (XTYPE (prefix) == Lisp_Vector - && XVECTOR (prefix)->size == 0)) + if ((STRINGP (prefix) && XSTRING (prefix)->size == 0) + || (VECTORP (prefix) && XVECTOR (prefix)->size == 0)) ; /* If the sequence by which we reach this keymap actually has some elements, then the sequence's definition in SHADOW is what we should use. */ else { - shmap = Flookup_key (shadow, Fcar (elt), Qt); - if (XTYPE (shmap) == Lisp_Int) + shmap = Flookup_key (shmap, Fcar (elt), Qt); + if (INTEGERP (shmap)) shmap = Qnil; } @@ -1963,7 +2006,8 @@ key binding\n\ sub_shadows = Fcons (shmap, sub_shadows); } - describe_map (Fcdr (elt), Fcar (elt), partial, sub_shadows); + describe_map (Fcdr (elt), Fcar (elt), describe_command, + partial, sub_shadows, &seen); skip: ; } @@ -1982,9 +2026,9 @@ describe_command (definition) Findent_to (make_number (16), make_number (1)); - if (XTYPE (definition) == Lisp_Symbol) + if (SYMBOLP (definition)) { - XSET (tem1, Lisp_String, XSYMBOL (definition)->name); + XSETSTRING (tem1, XSYMBOL (definition)->name); insert1 (tem1); insert_string ("\n"); } @@ -2000,31 +2044,6 @@ describe_command (definition) } } -/* 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 is as in `describe_map_tree' above. */ - -static void -describe_map (map, keys, partial, shadow) - Lisp_Object map, keys; - int partial; - Lisp_Object shadow; -{ - register Lisp_Object keysdesc; - - if (!NILP (keys) && XFASTINT (Flength (keys)) > 0) - { - Lisp_Object tem; - /* Call Fkey_description first, to avoid GC bug for the other string. */ - tem = Fkey_description (keys); - keysdesc = concat2 (tem, build_string (" ")); - } - else - keysdesc = Qnil; - - describe_map_2 (map, keysdesc, describe_command, partial, shadow); -} - /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. Returns the first non-nil binding found in any of those maps. */ @@ -2043,16 +2062,20 @@ shadow_lookup (shadow, key, flag) return Qnil; } -/* Insert a description of KEYMAP into the current buffer. */ +/* 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. */ static void -describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) - register Lisp_Object keymap; - Lisp_Object elt_prefix; +describe_map (map, keys, elt_describer, partial, shadow, seen) + register Lisp_Object map; + Lisp_Object keys; int (*elt_describer) (); int partial; Lisp_Object shadow; + Lisp_Object *seen; { + Lisp_Object elt_prefix; Lisp_Object tail, definition, event; Lisp_Object tem; Lisp_Object suppress; @@ -2060,6 +2083,15 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) int first = 1; struct gcpro gcpro1, gcpro2, gcpro3; + if (!NILP (keys) && XFASTINT (Flength (keys)) > 0) + { + /* Call Fkey_description first, to avoid GC bug for the other string. */ + tem = Fkey_description (keys); + elt_prefix = concat2 (tem, build_string (" ")); + } + else + elt_prefix = Qnil; + if (partial) suppress = intern ("suppress-keymap"); @@ -2071,21 +2103,27 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) GCPRO3 (elt_prefix, definition, kludge); - for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = Fcdr (tail)) + for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) { QUIT; - if (XTYPE (XCONS (tail)->car) == Lisp_Vector) + if (VECTORP (XCONS (tail)->car)) describe_vector (XCONS (tail)->car, elt_prefix, elt_describer, partial, shadow); - else + else if (CONSP (XCONS (tail)->car)) { - event = Fcar_safe (Fcar (tail)); - definition = get_keyelt (Fcdr_safe (Fcar (tail))); + event = XCONS (XCONS (tail)->car)->car; + + /* Ignore bindings whose "keys" are not really valid events. + (We get these in the frames and buffers menu.) */ + if (! (SYMBOLP (event) || INTEGERP (event))) + continue; + + definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0); /* Don't show undefined commands or suppressed commands. */ if (NILP (definition)) continue; - if (XTYPE (definition) == Lisp_Symbol && partial) + if (SYMBOLP (definition) && partial) { tem = Fget (definition, suppress); if (!NILP (tem)) @@ -2102,7 +2140,7 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) if (!NILP (tem)) continue; } - tem = Flookup_key (keymap, kludge, Qt); + tem = Flookup_key (map, kludge, Qt); if (! EQ (tem, definition)) continue; if (first) @@ -2122,6 +2160,16 @@ describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) for alignment purposes. */ (*elt_describer) (definition); } + else if (EQ (XCONS (tail)->car, 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))) + break; + *seen = Fcons (Fcons (tail, keys), *seen); + } } UNGCPRO; @@ -2181,12 +2229,12 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow) for (i = 0; i < XVECTOR (vector)->size; i++) { QUIT; - tem1 = get_keyelt (XVECTOR (vector)->contents[i]); + tem1 = get_keyelt (XVECTOR (vector)->contents[i], 0); if (NILP (tem1)) continue; /* Don't mention suppressed commands. */ - if (XTYPE (tem1) == Lisp_Symbol && partial) + if (SYMBOLP (tem1) && partial) { this = Fget (tem1, suppress); if (!NILP (this)) @@ -2216,7 +2264,7 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow) insert1 (elt_prefix); /* Get the string to describe the character I, and print it. */ - XFASTINT (dummy) = i; + XSETFASTINT (dummy, i); /* THIS gets the string to describe the character DUMMY. */ this = Fsingle_key_description (dummy); @@ -2224,7 +2272,7 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow) /* Find all consecutive characters that have the same definition. */ while (i + 1 < XVECTOR (vector)->size - && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]), + && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1], 0), EQ (tem2, tem1))) i++; @@ -2237,7 +2285,7 @@ describe_vector (vector, elt_prefix, elt_describer, partial, shadow) if (!NILP (elt_prefix)) insert1 (elt_prefix); - XFASTINT (dummy) = i; + XSETFASTINT (dummy, i); insert1 (Fsingle_key_description (dummy)); } @@ -2340,15 +2388,18 @@ in the list takes precedence."); This allows Emacs to recognize function keys sent from ASCII\n\ terminals at any point in a key sequence.\n\ \n\ -The read-key-sequence function replaces subsequences bound by\n\ -function-key-map with their bindings. When the current local and global\n\ +The `read-key-sequence' function replaces any subsequence bound by\n\ +`function-key-map' with its binding. More precisely, when the active\n\ keymaps have no binding for the current key sequence but\n\ -function-key-map binds a suffix of the sequence to a vector or string,\n\ -read-key-sequence replaces the matching suffix with its binding, and\n\ +`function-key-map' binds a suffix of the sequence to a vector or string,\n\ +`read-key-sequence' replaces the matching suffix with its binding, and\n\ continues with the new sequence.\n\ \n\ -For example, suppose function-key-map binds `ESC O P' to [f1].\n\ -Typing `ESC O P' to read-key-sequence would return [f1]. Typing\n\ +The events that come from bindings in `function-key-map' are not\n\ +themselves looked up in `function-key-map'.\n\ +\n\ +For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\ +Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\ `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\ key, typing `ESC O P x' would return [f1 x]."); Vfunction_key_map = Fmake_sparse_keymap (Qnil); @@ -2373,12 +2424,8 @@ key, typing `ESC O P x' would return [f1 x]."); defsubr (&Slocal_key_binding); defsubr (&Sglobal_key_binding); defsubr (&Sminor_mode_key_binding); - defsubr (&Sglobal_set_key); - defsubr (&Slocal_set_key); defsubr (&Sdefine_key); defsubr (&Slookup_key); - defsubr (&Sglobal_unset_key); - defsubr (&Slocal_unset_key); defsubr (&Sdefine_prefix_command); defsubr (&Suse_global_map); defsubr (&Suse_local_map);