X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/416349ecf28b2a8b883aad1d798f0118265bc40c..c7dd82a34d3b058a81d11823a7f730f6607bd43d:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 13b8b26223..abceaa5030 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -163,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 */ @@ -284,7 +284,7 @@ access_keymap (map, idx, t_ok, noinherit) 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 (INTEGERP (idx) - && 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; @@ -399,6 +395,12 @@ store_in_keymap (keymap, idx, def) register Lisp_Object idx; register Lisp_Object def; { + /* If we are preparing to dump, and DEF is a menu element + with a menu item string, copy it to ensure it is not pure. */ + if (!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"); @@ -414,7 +416,7 @@ store_in_keymap (keymap, idx, def) 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. */ { @@ -434,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 (INTEGERP (idx) - && 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; @@ -470,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; @@ -608,6 +607,9 @@ the front of KEYMAP.") { c = Faref (key, make_number (idx)); + if (CONSP (c) && lucid_event_type_list_p (c)) + c = convert_event_type_list (c); + if (INTEGERP (c) && (XINT (c) & meta_bit) && !metized) @@ -699,6 +701,9 @@ recognize the default bindings, just as `read-key-sequence' does.") { c = Faref (key, make_number (idx)); + if (CONSP (c) && lucid_event_type_list_p (c)) + c = convert_event_type_list (c); + if (INTEGERP (c) && (XINT (c) & meta_bit) && !metized) @@ -812,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) - && SYMBOLP (var = XCONS (assoc)->car) - && ! 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) @@ -1000,74 +1005,6 @@ bindings; see the description of `lookup-key' for more details about this.") 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 (!VECTORP (keys) && !STRINGP (keys)) - 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 (!VECTORP (keys) && !STRINGP (keys)) - 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\ @@ -1317,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; } @@ -1352,11 +1289,11 @@ spaces are put between sequence elements, etc.") 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; } @@ -1501,22 +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); - - /* Buffer names in the menubar can trigger this. */ - case Lisp_String: - return Fcopy_sequence (key); - - default: - error ("KEY must be an integer, cons, symbol, or string"); } + 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 * @@ -1568,14 +1500,15 @@ 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 (!INTEGERP (elt) || (XUINT (elt) & ~CHAR_META) >= 0x80) @@ -1597,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\ @@ -1613,6 +1546,8 @@ indirect definition itself.") 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) { @@ -1692,7 +1627,7 @@ indirect definition itself.") { /* 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 @@ -1721,7 +1656,28 @@ indirect definition itself.") /* Search through indirections unless that's not wanted. */ if (NILP (noindirect)) - binding = get_keyelt (binding, 0); + { + 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. */ @@ -1820,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)); @@ -1937,6 +1893,7 @@ 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; @@ -2071,7 +2028,7 @@ describe_command (definition) if (SYMBOLP (definition)) { - XSET (tem1, Lisp_String, XSYMBOL (definition)->name); + XSETSTRING (tem1, XSYMBOL (definition)->name); insert1 (tem1); insert_string ("\n"); } @@ -2307,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); @@ -2328,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)); } @@ -2467,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);