X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/95a2cb24b0697558e6629460d8bc693b394f0138..50650cb6887d99b01eeb1e686fc1f695c2a0c64a:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 34fe1cb7a9..c975aad27d 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,13 +1,13 @@ /* Manipulation of keymaps - Copyright (C) 1985-1988, 1993-1995, 1998-2015 Free Software + Copyright (C) 1985-1988, 1993-1995, 1998-2016 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -46,9 +46,7 @@ along with GNU Emacs. If not, see . */ #include "commands.h" #include "character.h" #include "buffer.h" -#include "charset.h" #include "keyboard.h" -#include "frame.h" #include "termhooks.h" #include "blockinput.h" #include "puresize.h" @@ -254,12 +252,7 @@ get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload) { if (autoload) { - struct gcpro gcpro1, gcpro2; - - GCPRO2 (tem, object); Fautoload_do_load (tem, object, Qnil); - UNGCPRO; - goto autoload_retry; } else @@ -322,12 +315,10 @@ Return PARENT. PARENT should be nil or another keymap. */) (Lisp_Object keymap, Lisp_Object parent) { Lisp_Object list, prev; - struct gcpro gcpro1, gcpro2; /* Flush any reverse-map cache. */ where_is_cache = Qnil; where_is_cache_keymaps = Qt; - GCPRO2 (keymap, parent); keymap = get_keymap (keymap, 1, 1); if (!NILP (parent)) @@ -348,9 +339,9 @@ Return PARENT. PARENT should be nil or another keymap. */) If we came to the end, add the parent in PREV. */ if (!CONSP (list) || KEYMAPP (list)) { - CHECK_IMPURE (prev); + CHECK_IMPURE (prev, XCONS (prev)); XSETCDR (prev, parent); - RETURN_UNGCPRO (parent); + return parent; } prev = list; } @@ -397,9 +388,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, { /* See if there is a meta-map. If there's none, there is no binding for IDX, unless a default binding exists in MAP. */ - struct gcpro gcpro1; Lisp_Object event_meta_binding, event_meta_map; - GCPRO1 (map); /* A strange value in which Meta is set would cause infinite recursion. Protect against that. */ if (XINT (meta_prefix_char) & CHAR_META) @@ -407,7 +396,6 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok, noinherit, autoload); event_meta_map = get_keymap (event_meta_binding, 0, autoload); - UNGCPRO; if (CONSP (event_meta_map)) { map = event_meta_map; @@ -429,9 +417,6 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, Lisp_Object t_binding = Qunbound; Lisp_Object retval = Qunbound; Lisp_Object retval_tail = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - GCPRO4 (tail, idx, t_binding, retval); for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map; (CONSP (tail) @@ -498,7 +483,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, if (INTEGERP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0) { val = Faref (binding, idx); - /* `nil' has a special meaning for char-tables, so + /* nil has a special meaning for char-tables, so we use something else to record an explicitly unbound entry. */ if (NILP (val)) @@ -539,7 +524,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, } QUIT; } - UNGCPRO; + return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval; } } @@ -584,11 +569,9 @@ map_keymap_internal (Lisp_Object map, Lisp_Object args, void *data) { - struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map; - GCPRO3 (map, args, tail); for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail)) { Lisp_Object binding = XCAR (tail); @@ -614,7 +597,7 @@ map_keymap_internal (Lisp_Object map, make_save_funcptr_ptr_obj ((voidfuncptr) fun, data, args)); } - UNGCPRO; + return tail; } @@ -630,8 +613,6 @@ void map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, bool autoload) { - struct gcpro gcpro1; - GCPRO1 (args); map = get_keymap (map, 1, autoload); while (CONSP (map)) { @@ -645,7 +626,6 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, if (!CONSP (map)) map = get_keymap (map, 0, autoload); } - UNGCPRO; } /* Same as map_keymap, but does it right, properly eliminating duplicate @@ -653,14 +633,11 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void map_keymap_canonical (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data) { - struct gcpro gcpro1; - GCPRO1 (args); /* map_keymap_canonical may be used from redisplay (e.g. when building menus) so be careful to ignore errors and to inhibit redisplay. */ map = safe_call1 (Qkeymap_canonicalize, map); /* No need to use `map_keymap' here because canonical map has no parent. */ map_keymap_internal (map, fun, args, data); - UNGCPRO; } DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0, @@ -670,11 +647,8 @@ the definition it is bound to. The event may be a character range. If KEYMAP has a parent, this function returns it without processing it. */) (Lisp_Object function, Lisp_Object keymap) { - struct gcpro gcpro1; - GCPRO1 (function); keymap = get_keymap (keymap, 1, 1); keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL); - UNGCPRO; return keymap; } @@ -774,7 +748,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) /* If we are preparing to dump, and DEF is a menu element with a menu item indicator, copy it to ensure it is not pure. */ - if (CONSP (def) && PURE_P (def) + if (CONSP (def) && PURE_P (XCONS (def)) && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def)))) def = Fcons (XCAR (def), XCDR (def)); @@ -822,7 +796,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) { if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt)) { - CHECK_IMPURE (elt); + CHECK_IMPURE (elt, XVECTOR (elt)); ASET (elt, XFASTINT (idx), def); return def; } @@ -849,7 +823,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK)) { Faset (elt, idx, - /* `nil' has a special meaning for char-tables, so + /* nil has a special meaning for char-tables, so we use something else to record an explicitly unbound entry. */ NILP (def) ? Qt : def); @@ -875,11 +849,13 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) } else if (EQ (idx, XCAR (elt))) { - CHECK_IMPURE (elt); + CHECK_IMPURE (elt, XCONS (elt)); XSETCDR (elt, def); return def; } - else if (CONSP (idx) && CHARACTERP (XCAR (idx))) + else if (CONSP (idx) + && CHARACTERP (XCAR (idx)) + && CHARACTERP (XCAR (elt))) { int from = XFASTINT (XCAR (idx)); int to = XFASTINT (XCDR (idx)); @@ -919,7 +895,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) } else elt = Fcons (idx, def); - CHECK_IMPURE (insertion_point); + CHECK_IMPURE (insertion_point, XCONS (insertion_point)); XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point))); } } @@ -1079,14 +1055,12 @@ binding KEY to DEF is added at the front of KEYMAP. */) bool metized = 0; int meta_bit; ptrdiff_t length; - struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (keymap, key, def); keymap = get_keymap (keymap, 1, 1); length = CHECK_VECTOR_OR_STRING (key); if (length == 0) - RETURN_UNGCPRO (Qnil); + return Qnil; if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); @@ -1149,7 +1123,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) message_with_string ("Key sequence contains invalid event %s", c, 1); if (idx == length) - RETURN_UNGCPRO (store_in_keymap (keymap, c, def)); + return store_in_keymap (keymap, c, def); cmd = access_keymap (keymap, c, 0, 1, 1); @@ -1233,14 +1207,12 @@ recognize the default bindings, just as `read-key-sequence' does. */) Lisp_Object c; ptrdiff_t length; bool t_ok = !NILP (accept_default); - struct gcpro gcpro1, gcpro2; - GCPRO2 (keymap, key); keymap = get_keymap (keymap, 1, 1); length = CHECK_VECTOR_OR_STRING (key); if (length == 0) - RETURN_UNGCPRO (keymap); + return keymap; idx = 0; while (1) @@ -1261,11 +1233,11 @@ recognize the default bindings, just as `read-key-sequence' does. */) cmd = access_keymap (keymap, c, t_ok, 0, 1); if (idx == length) - RETURN_UNGCPRO (cmd); + return cmd; keymap = get_keymap (cmd, 0, 1); if (!CONSP (keymap)) - RETURN_UNGCPRO (make_number (idx)); + return make_number (idx); QUIT; } @@ -1652,10 +1624,14 @@ specified buffer position instead of point are used. if (NILP (position) && VECTORP (key)) { - Lisp_Object event - /* mouse events may have a symbolic prefix indicating the - scrollbar or mode line */ - = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0); + Lisp_Object event; + + if (ASIZE (key) == 0) + return Qnil; + + /* mouse events may have a symbolic prefix indicating the + scrollbar or mode line */ + event = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0); /* We are not interested in locations without event data */ @@ -1740,14 +1716,10 @@ 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]) @@ -1757,19 +1729,20 @@ bindings; see the description of `lookup-key' for more details about this. */) if (KEYMAPP (binding)) maps[j++] = Fcons (modes[i], binding); else if (j == 0) - RETURN_UNGCPRO (list1 (Fcons (modes[i], binding))); + return list1 (Fcons (modes[i], binding)); } - UNGCPRO; return Flist (j, maps); } DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0, doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol. -A new sparse keymap is stored as COMMAND's function definition and its value. -If a second optional argument MAPVAR is given, the map is stored as -its value instead of as COMMAND's value; but COMMAND is still defined -as a function. +A new sparse keymap is stored as COMMAND's function definition and its +value. +This prepares COMMAND for use as a prefix key's binding. +If a second optional argument MAPVAR is given, it should be a symbol. +The map is then stored as MAPVAR's value instead of as COMMAND's +value; but COMMAND is still defined as a function. The third optional argument NAME, if given, supplies a menu name string for the map. This is required to use the keymap as a menu. This function returns COMMAND. */) @@ -1918,8 +1891,6 @@ then the value includes only maps for prefixes that start with PREFIX. */) Lisp_Object maps, tail; EMACS_INT prefixlen = XFASTINT (Flength (prefix)); - /* no need for gcpro because we don't autoload any keymaps. */ - if (!NILP (prefix)) { /* If a prefix was specified, start with the keymap (if any) for @@ -2017,9 +1988,10 @@ For an approximate inverse of this, see `kbd'. */) size += XINT (Flength (prefix)); /* This has one extra element at the end that we don't pass to Fconcat. */ - if (min (PTRDIFF_MAX, SIZE_MAX) / word_size / 4 < size) + EMACS_INT size4; + if (INT_MULTIPLY_WRAPV (size, 4, &size4)) memory_full (SIZE_MAX); - SAFE_ALLOCA_LISP (args, size * 4); + SAFE_ALLOCA_LISP (args, size4); /* In effect, this computes (mapconcat 'single-key-description keys " ") @@ -2549,7 +2521,6 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: Lisp_Object found = Qnil; /* 1 means ignore all menu bindings entirely. */ bool nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii); - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; /* List of sequences found via remapping. Keep them in a separate variable, so as to push them later, since we prefer non-remapped binding. */ @@ -2572,8 +2543,6 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: else keymaps = Fcurrent_active_maps (Qnil, Qnil); - GCPRO6 (definition, keymaps, found, sequences, remapped_sequences, tem); - tem = Fcommand_remapping (definition, Qnil, keymaps); /* If `definition' is remapped to tem', then OT1H no key will run that command (since they will run `tem' instead), so we should @@ -2599,11 +2568,11 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: /* We have a list of advertised bindings. */ while (CONSP (tem)) if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition)) - RETURN_UNGCPRO (XCAR (tem)); + return XCAR (tem); else tem = XCDR (tem); if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition)) - RETURN_UNGCPRO (tem); + return tem; } sequences = Freverse (where_is_internal (definition, keymaps, @@ -2672,14 +2641,12 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: nil, then we should return the first ascii-only binding we find. */ if (EQ (firstonly, Qnon_ascii)) - RETURN_UNGCPRO (sequence); + return sequence; else if (!NILP (firstonly) && 2 == preferred_sequence_p (sequence)) - RETURN_UNGCPRO (sequence); + return sequence; } - UNGCPRO; - found = Fnreverse (found); /* firstonly may have been t, but we may have gone all the way through @@ -2765,7 +2732,6 @@ The optional argument MENUS, if non-nil, says to mention menu bindings. Lisp_Object outbuf, shadow; bool nomenu = NILP (menus); Lisp_Object start1; - struct gcpro gcpro1; const char *alternate_heading = "\ @@ -2776,8 +2742,6 @@ You type Translation\n\ CHECK_BUFFER (buffer); shadow = Qnil; - GCPRO1 (shadow); - outbuf = Fcurrent_buffer (); /* Report on alternates for keys. */ @@ -2923,7 +2887,6 @@ You type Translation\n\ describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix, "\f\nInput decoding map translations", nomenu, 1, 0, 0); - UNGCPRO; return Qnil; } @@ -2955,7 +2918,6 @@ describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow, bool transl, bool always_title, bool mention_shadow) { Lisp_Object maps, orig_maps, seen, sub_shadows; - struct gcpro gcpro1, gcpro2, gcpro3; bool something = 0; const char *key_heading = "\ @@ -2965,7 +2927,6 @@ key binding\n\ orig_maps = maps = Faccessible_keymaps (startmap, prefix); seen = Qnil; sub_shadows = Qnil; - GCPRO3 (maps, seen, sub_shadows); if (nomenu) { @@ -3061,8 +3022,6 @@ key binding\n\ if (something) insert_string ("\n"); - - UNGCPRO; } static int previous_description_column; @@ -3174,7 +3133,6 @@ describe_map (Lisp_Object map, Lisp_Object prefix, Lisp_Object suppress; Lisp_Object kludge; bool first = 1; - struct gcpro gcpro1, gcpro2, gcpro3; /* These accumulate the values from sparse keymap bindings, so we can sort them and handle them in order. */ @@ -3194,8 +3152,6 @@ describe_map (Lisp_Object map, Lisp_Object prefix, kludge = Fmake_vector (make_number (1), Qnil); definition = Qnil; - GCPRO3 (prefix, definition, kludge); - map = call1 (Qkeymap_canonicalize, map); for (tail = map; CONSP (tail); tail = XCDR (tail)) @@ -3346,7 +3302,6 @@ describe_map (Lisp_Object map, Lisp_Object prefix, } SAFE_FREE (); - UNGCPRO; } static void @@ -3419,7 +3374,6 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, Lisp_Object suppress; Lisp_Object kludge; bool first = 1; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* Range of elements to be handled. */ int from, to, stop; Lisp_Object character; @@ -3445,7 +3399,6 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, that is done once per vector element, we don't want to cons up a fresh vector every time. */ kludge = Fmake_vector (make_number (1), Qnil); - GCPRO4 (elt_prefix, prefix, definition, kludge); if (partial) suppress = intern ("suppress-keymap"); @@ -3595,8 +3548,6 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, insert ("default", 7); (*elt_describer) (XCHAR_TABLE (vector)->defalt, args); } - - UNGCPRO; } /* Apropos - finding all symbols whose names match a regexp. */ @@ -3730,8 +3681,8 @@ be preferred. */); staticpro (&Vmouse_events); Vmouse_events = listn (CONSTYPE_PURE, 9, Qmenu_bar, - intern_c_string ("tool-bar"), - intern_c_string ("header-line"), + Qtool_bar, + Qheader_line, Qmode_line, intern_c_string ("mouse-1"), intern_c_string ("mouse-2"), @@ -3739,9 +3690,6 @@ be preferred. */); intern_c_string ("mouse-4"), intern_c_string ("mouse-5")); - DEFSYM (Qsingle_key_description, "single-key-description"); - DEFSYM (Qkey_description, "key-description"); - /* Keymap used for minibuffers when doing completion. */ /* Keymap used for minibuffers when doing completion and require a match. */ DEFSYM (Qkeymapp, "keymapp");