X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1abfd3e85fa9b340699430cd9e15dd9f0073bdbe..2bfa3d3e1fb347ba76bddf77f3e288049635821d:/src/keymap.c diff --git a/src/keymap.c b/src/keymap.c index 922c1703ed..5b0b8747b4 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1,5 +1,5 @@ /* Manipulation of keymaps - Copyright (C) 1985-1988, 1993-1995, 1998-2013 Free Software + Copyright (C) 1985-1988, 1993-1995, 1998-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -56,28 +56,28 @@ along with GNU Emacs. If not, see . */ #include "keymap.h" #include "window.h" -/* Actually allocate storage for these variables */ +/* Actually allocate storage for these variables. */ -Lisp_Object current_global_map; /* Current global keymap */ +Lisp_Object current_global_map; /* Current global keymap. */ -Lisp_Object global_map; /* default global key bindings */ +Lisp_Object global_map; /* Default global key bindings. */ Lisp_Object meta_map; /* The keymap used for globally bound - ESC-prefixed default commands */ + ESC-prefixed default commands. */ Lisp_Object control_x_map; /* The keymap used for globally bound - C-x-prefixed default commands */ + C-x-prefixed default commands. */ /* The keymap used by the minibuf for local bindings when spaces are allowed in the - minibuf */ + minibuf. */ /* The keymap used by the minibuf for local bindings when spaces are not encouraged - in the minibuf */ + in the minibuf. */ -/* keymap used for minibuffers when doing completion */ -/* keymap used for minibuffers when doing completion and require a match */ +/* Keymap used for minibuffers when doing completion. */ +/* Keymap used for minibuffers when doing completion and require a match. */ static Lisp_Object Qkeymapp, Qnon_ascii; Lisp_Object Qkeymap, Qmenu_item, Qremap; static Lisp_Object QCadvertised_binding; @@ -106,6 +106,12 @@ static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, bool, bool); static void silly_event_symbol_error (Lisp_Object); static Lisp_Object get_keyelt (Lisp_Object, bool); + +static void +CHECK_VECTOR_OR_CHAR_TABLE (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x); +} /* Keymap object support - constructors and predicates. */ @@ -123,7 +129,7 @@ in case you use it as a menu with `x-popup-menu'. */) { Lisp_Object tail; if (!NILP (string)) - tail = Fcons (string, Qnil); + tail = list1 (string); else tail = Qnil; return Fcons (Qkeymap, @@ -145,9 +151,9 @@ in case you use it as a menu with `x-popup-menu'. */) { if (!NILP (Vpurify_flag)) string = Fpurecopy (string); - return Fcons (Qkeymap, Fcons (string, Qnil)); + return list2 (Qkeymap, string); } - return Fcons (Qkeymap, Qnil); + return list1 (Qkeymap); } /* This function is used for installing the standard key bindings @@ -350,7 +356,7 @@ Return PARENT. PARENT should be nil or another keymap. */) { CHECK_IMPURE (prev); XSETCDR (prev, parent); - RETURN_UNGCPRO (parent); + return parent; } prev = list; } @@ -528,12 +534,12 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, retval = val; else if (CONSP (retval_tail)) { - XSETCDR (retval_tail, Fcons (val, Qnil)); + XSETCDR (retval_tail, list1 (val)); retval_tail = XCDR (retval_tail); } else { - retval_tail = Fcons (val, Qnil); + retval_tail = list1 (val); retval = Fcons (Qkeymap, Fcons (retval, retval_tail)); } } @@ -565,7 +571,8 @@ map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val) { if (!NILP (val)) { - map_keymap_function_t fun = XSAVE_POINTER (args, 0); + map_keymap_function_t fun + = (map_keymap_function_t) XSAVE_FUNCPOINTER (args, 0); /* If the key is a range, make a copy since map_char_table modifies it in place. */ if (CONSP (key)) @@ -610,7 +617,8 @@ map_keymap_internal (Lisp_Object map, } else if (CHAR_TABLE_P (binding)) map_char_table (map_keymap_char_table_item, Qnil, binding, - make_save_value ("ppo", fun, data, args)); + make_save_funcptr_ptr_obj ((voidfuncptr) fun, data, + args)); } UNGCPRO; return tail; @@ -1037,9 +1045,9 @@ However, a key definition which is a symbol whose definition is a keymap is not copied. */) (Lisp_Object keymap) { - register Lisp_Object copy, tail; + Lisp_Object copy, tail; keymap = get_keymap (keymap, 1, 0); - copy = tail = Fcons (Qkeymap, Qnil); + copy = tail = list1 (Qkeymap); keymap = XCDR (keymap); /* Skip the `keymap' symbol. */ while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap)) @@ -1065,7 +1073,7 @@ is not copied. */) else elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt))); } - XSETCDR (tail, Fcons (elt, Qnil)); + XSETCDR (tail, list1 (elt)); tail = XCDR (tail); keymap = XCDR (keymap); } @@ -1123,7 +1131,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) length = XFASTINT (Flength (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); @@ -1186,7 +1194,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); @@ -1279,7 +1287,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) length = XFASTINT (Flength (key)); if (length == 0) - RETURN_UNGCPRO (keymap); + return keymap; idx = 0; while (1) @@ -1300,11 +1308,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; } @@ -1333,8 +1341,7 @@ append_key (Lisp_Object key_sequence, Lisp_Object key) Lisp_Object args[2]; args[0] = key_sequence; - - args[1] = Fcons (key, Qnil); + args[1] = list1 (key); return Fvconcat (2, args); } @@ -1376,9 +1383,7 @@ silly_event_symbol_error (Lisp_Object c) c = reorder_modifiers (c); keystring = concat2 (build_string (new_mods), XCDR (assoc)); - error ((modifiers & ~meta_modifier - ? "To bind the key %s, use [?%s], not [%s]" - : "To bind the key %s, use \"%s\", not [%s]"), + error ("To bind the key %s, use [?%s], not [%s]", SDATA (SYMBOL_NAME (c)), SDATA (keystring), SDATA (SYMBOL_NAME (c))); } @@ -1472,26 +1477,26 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr) /* Use malloc here. See the comment above this function. Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */ block_input (); - newmodes = malloc (allocsize); + newmodes = xmalloc_unsafe (allocsize); if (newmodes) { if (cmm_modes) { memcpy (newmodes, cmm_modes, cmm_size * sizeof cmm_modes[0]); - free (cmm_modes); + xfree (cmm_modes); } cmm_modes = newmodes; } - newmaps = malloc (allocsize); + newmaps = xmalloc_unsafe (allocsize); if (newmaps) { if (cmm_maps) { memcpy (newmaps, cmm_maps, cmm_size * sizeof cmm_maps[0]); - free (cmm_maps); + xfree (cmm_maps); } cmm_maps = newmaps; } @@ -1539,9 +1544,9 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and like in the respective argument of `key-binding'. */) (Lisp_Object olp, Lisp_Object position) { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); - Lisp_Object keymaps = Fcons (current_global_map, Qnil); + Lisp_Object keymaps = list1 (current_global_map); /* If a mouse click position is given, our variables are based on the buffer clicked on, not the current buffer. So we may have to @@ -1554,8 +1559,8 @@ like in the respective argument of `key-binding'. */) window = POSN_WINDOW (position); if (WINDOWP (window) - && BUFFERP (XWINDOW (window)->buffer) - && XBUFFER (XWINDOW (window)->buffer) != current_buffer) + && BUFFERP (XWINDOW (window)->contents) + && XBUFFER (XWINDOW (window)->contents) != current_buffer) { /* Arrange to go back to the original buffer once we're done processing the key sequence. We don't use @@ -1565,21 +1570,18 @@ like in the respective argument of `key-binding'. */) things the same. */ record_unwind_current_buffer (); - set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); + set_buffer_internal (XBUFFER (XWINDOW (window)->contents)); } } - if (!NILP (olp)) - { - if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) - keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), - keymaps); + if (!NILP (olp) /* The doc said that overriding-terminal-local-map should override overriding-local-map. The code used them both, but it seems clearer to use just one. rms, jan 2005. */ - else if (!NILP (Voverriding_local_map)) - keymaps = Fcons (Voverriding_local_map, keymaps); - } + && NILP (KVAR (current_kboard, Voverriding_terminal_local_map)) + && !NILP (Voverriding_local_map)) + keymaps = Fcons (Voverriding_local_map, keymaps); + if (NILP (XCDR (keymaps))) { Lisp_Object *maps; @@ -1590,6 +1592,7 @@ like in the respective argument of `key-binding'. */) Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map); /* This returns nil unless there is a `keymap' property. */ Lisp_Object keymap = get_local_map (pt, current_buffer, Qkeymap); + Lisp_Object otlp = KVAR (current_kboard, Voverriding_terminal_local_map); if (CONSP (position)) { @@ -1654,9 +1657,12 @@ like in the respective argument of `key-binding'. */) if (!NILP (keymap)) keymaps = Fcons (keymap, keymaps); + + if (!NILP (olp) && !NILP (otlp)) + keymaps = Fcons (otlp, keymaps); } - unbind_to (count, Qnil); + dynwind_end (); return keymaps; } @@ -1800,7 +1806,7 @@ 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 (Fcons (Fcons (modes[i], binding), Qnil)); + return list1 (Fcons (modes[i], binding)); } UNGCPRO; @@ -1886,7 +1892,7 @@ struct accessible_keymaps_data { static void accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *data) -/* Use void* data to be compatible with map_keymap_function_t. */ +/* Use void * data to be compatible with map_keymap_function_t. */ { struct accessible_keymaps_data *d = data; /* Cast! */ Lisp_Object maps = d->maps; @@ -1942,7 +1948,7 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void * else { tem = append_key (thisseq, key); - nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); + nconc2 (tail, list1 (Fcons (tem, cmd))); } } @@ -1996,13 +2002,13 @@ then the value includes only maps for prefixes that start with PREFIX. */) } prefix = copy; } - maps = Fcons (Fcons (prefix, tem), Qnil); + maps = list1 (Fcons (prefix, tem)); } else return Qnil; } else - maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil); + maps = list1 (Fcons (zero_vector, get_keymap (keymap, 1, 0))); /* For each map in the list maps, look at any other maps it points to, @@ -2310,7 +2316,6 @@ around function keys and event symbols. */) return Fcopy_sequence (key); else error ("KEY must be an integer, cons, symbol, or string"); - return Qnil; } static char * @@ -2611,7 +2616,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: if (CONSP (keymap) && KEYMAPP (XCAR (keymap))) keymaps = keymap; else if (!NILP (keymap)) - keymaps = Fcons (keymap, Fcons (current_global_map, Qnil)); + keymaps = list2 (keymap, current_global_map); else keymaps = Fcurrent_active_maps (Qnil, Qnil); @@ -2642,11 +2647,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, @@ -2715,10 +2720,10 @@ 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; @@ -2850,7 +2855,7 @@ You type Translation\n\ insert ("\n", 1); - /* Insert calls signal_after_change which may GC. */ + /* Insert calls signal_after_change which may GC. */ translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table)); } @@ -2866,6 +2871,14 @@ You type Translation\n\ start1 = Qnil; if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) start1 = KVAR (current_kboard, Voverriding_terminal_local_map); + + if (!NILP (start1)) + { + describe_map_tree (start1, 1, shadow, prefix, + "\f\nOverriding Bindings", nomenu, 0, 0, 0); + shadow = Fcons (start1, shadow); + start1 = Qnil; + } else if (!NILP (Voverriding_local_map)) start1 = Voverriding_local_map; @@ -3234,8 +3247,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix, for (tail = map; CONSP (tail); tail = XCDR (tail)) length_needed++; - vect = ((struct describe_map_elt *) - alloca (sizeof (struct describe_map_elt) * length_needed)); + vect = alloca (length_needed * sizeof *vect); for (tail = map; CONSP (tail); tail = XCDR (tail)) { @@ -3369,9 +3381,12 @@ describe_map (Lisp_Object map, Lisp_Object prefix, if (vect[i].shadowed) { - SET_PT (PT - 1); + ptrdiff_t pt = max (PT - 1, BEG); + + SET_PT (pt); insert_string ("\n (that binding is currently shadowed by another mode)"); - SET_PT (PT + 1); + pt = min (PT + 1, Z); + SET_PT (pt); } } @@ -3392,7 +3407,7 @@ This is text showing the elements of vector matched against indices. DESCRIBER is the output function used; nil means use `princ'. */) (Lisp_Object vector, Lisp_Object describer) { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); if (NILP (describer)) describer = intern ("princ"); specbind (Qstandard_output, Fcurrent_buffer ()); @@ -3400,7 +3415,8 @@ DESCRIBER is the output function used; nil means use `princ'. */) describe_vector (vector, Qnil, describer, describe_vector_princ, 0, Qnil, Qnil, 0, 0); - return unbind_to (count, Qnil); + dynwind_end (); + return Qnil; } /* Insert in the current buffer a description of the contents of VECTOR. @@ -3665,6 +3681,8 @@ Return list of symbols found. */) void syms_of_keymap (void) { +#include "keymap.x" + DEFSYM (Qkeymap, "keymap"); staticpro (&apropos_predicate); staticpro (&apropos_accumulate); @@ -3736,7 +3754,7 @@ it is provided for major modes to bind locally. */); Vminor_mode_overriding_map_alist = Qnil; DEFVAR_LISP ("emulation-mode-map-alists", Vemulation_mode_map_alists, - doc: /* List of keymap alists to use for emulations modes. + doc: /* List of keymap alists to use for emulation modes. It is intended for modes or packages using multiple minor-mode keymaps. Each element is a keymap alist just like `minor-mode-map-alist', or a symbol with a variable binding which is a keymap alist, and it is used @@ -3780,38 +3798,6 @@ be preferred. */); where_is_cache = Qnil; staticpro (&where_is_cache); staticpro (&where_is_cache_keymaps); - - defsubr (&Skeymapp); - defsubr (&Skeymap_parent); - defsubr (&Skeymap_prompt); - defsubr (&Sset_keymap_parent); - defsubr (&Smake_keymap); - defsubr (&Smake_sparse_keymap); - defsubr (&Smap_keymap_internal); - defsubr (&Smap_keymap); - defsubr (&Scopy_keymap); - defsubr (&Scommand_remapping); - defsubr (&Skey_binding); - defsubr (&Slocal_key_binding); - defsubr (&Sglobal_key_binding); - defsubr (&Sminor_mode_key_binding); - defsubr (&Sdefine_key); - defsubr (&Slookup_key); - defsubr (&Sdefine_prefix_command); - defsubr (&Suse_global_map); - defsubr (&Suse_local_map); - 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); - defsubr (&Ssingle_key_description); - defsubr (&Stext_char_description); - defsubr (&Swhere_is_internal); - defsubr (&Sdescribe_buffer_bindings); - defsubr (&Sapropos_internal); } void