comparison src/keymap.c @ 5681:4af5a3435c94

Don't sanity-check commands with (define-key KEYMAP [remap COMMAND1] COMMAND2). lisp/ChangeLog addition: 2012-09-05 Aidan Kehoe <kehoea@parhasard.net> * keymap.c: * keymap.c (Fdefine_key): * keymap.c (remap_command): * keymap.c (Fremap_command): Don't sanity-check commands to be remapped with the (define-key KEYMAP [remap COMMAND1] COMMAND2) syntax, for better compatibility with GNU Emacs. Thank you Robert Pluim!
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 05 Sep 2012 20:37:58 +0100
parents a81a739181dc
children 7371081ce8f7
comparison
equal deleted inserted replaced
5680:8a2ac78cb97d 5681:4af5a3435c94
193 with any key named remap. */ 193 with any key named remap. */
194 194
195 EXFUN (Fkeymap_fullness, 1); 195 EXFUN (Fkeymap_fullness, 1);
196 EXFUN (Fset_keymap_name, 2); 196 EXFUN (Fset_keymap_name, 2);
197 EXFUN (Fsingle_key_description, 1); 197 EXFUN (Fsingle_key_description, 1);
198 EXFUN (Fremap_command, 3); 198
199 199 static Lisp_Object remap_command (Lisp_Object keymap, Lisp_Object old,
200 Lisp_Object new_);
200 static void describe_command (Lisp_Object definition, Lisp_Object buffer); 201 static void describe_command (Lisp_Object definition, Lisp_Object buffer);
201 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, 202 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
202 void (*elt_describer) (Lisp_Object, Lisp_Object), 203 void (*elt_describer) (Lisp_Object, Lisp_Object),
203 int partial, 204 int partial,
204 Lisp_Object shadow, 205 Lisp_Object shadow,
1937 if (len == 0) 1938 if (len == 0)
1938 return Qnil; 1939 return Qnil;
1939 1940
1940 GCPRO3 (keymap, keys, def); 1941 GCPRO3 (keymap, keys, def);
1941 1942
1942 /* Allow access to any keys named remap, use our uninterned symbol. */
1943 if (2 == len && VECTORP (keys) && EQ (Qremap, XVECTOR_DATA (keys) [0]))
1944 {
1945 return Fremap_command (keymap, XVECTOR_DATA (keys) [1], def);
1946 }
1947
1948 /* ASCII grunge. 1943 /* ASCII grunge.
1949 When the user defines a key which, in a strictly ASCII world, would be 1944 When the user defines a key which, in a strictly ASCII world, would be
1950 produced by two different keys (^J and linefeed, or ^H and backspace, 1945 produced by two different keys (^J and linefeed, or ^H and backspace,
1951 for example) then the binding will be made for both keysyms. 1946 for example) then the binding will be made for both keysyms.
1952 1947
1955 syntax (define-key map '(control h) 'something). 1950 syntax (define-key map '(control h) 'something).
1956 */ 1951 */
1957 ascii_hack = (STRINGP (keys)); 1952 ascii_hack = (STRINGP (keys));
1958 1953
1959 keymap = get_keymap (keymap, 1, 1); 1954 keymap = get_keymap (keymap, 1, 1);
1955
1956 /* Allow access to any keys named remap, use our uninterned symbol. For
1957 compatibility, don't sanity-check (aref KEYS 1) or DEF. */
1958 if (2 == len && VECTORP (keys) && EQ (Qremap, XVECTOR_DATA (keys) [0]))
1959 {
1960 RETURN_UNGCPRO (remap_command (keymap, XVECTOR_DATA (keys) [1], def));
1961 }
1960 1962
1961 idx = 0; 1963 idx = 0;
1962 while (1) 1964 while (1)
1963 { 1965 {
1964 Lisp_Object c; 1966 Lisp_Object c;
2064 NUNGCPRO; 2066 NUNGCPRO;
2065 } 2067 }
2066 } 2068 }
2067 } 2069 }
2068 2070
2071 static Lisp_Object
2072 remap_command (Lisp_Object keymap, Lisp_Object old, Lisp_Object new_)
2073 {
2074 Lisp_Key_Data parsed;
2075 Lisp_Object cmd;
2076
2077 define_key_parser (Qxemacs_command_remapping, &parsed);
2078 cmd = keymap_lookup_1 (keymap, &parsed, 0);
2079 if (NILP (cmd))
2080 {
2081 cmd = Fmake_sparse_keymap (Qnil);
2082 XKEYMAP (cmd)->name /* for debugging */
2083 = list2 (make_key_description (&parsed, 1), keymap);
2084 keymap_store (keymap, &parsed, cmd);
2085 }
2086
2087 assert (!NILP (Fkeymapp (cmd)));
2088 define_key_parser (old, &parsed);
2089 keymap_store (cmd, &parsed, new_);
2090 return new_;
2091 }
2092
2093
2069 DEFUN ("remap-command", Fremap_command, 3, 3, 0, /* 2094 DEFUN ("remap-command", Fremap_command, 3, 3, 0, /*
2070 Ensure that NEW is called when previously OLD would be, in KEYMAP. 2095 Ensure that NEW is called when previously OLD would be, in KEYMAP.
2071 2096
2072 NEW and OLD are both command symbols. KEYMAP is a keymap object. 2097 NEW and OLD are both command symbols. KEYMAP is a keymap object.
2073 2098
2074 This is equivalent to `(define-key KEYMAP [remap OLD] NEW])'. See also 2099 This is equivalent to `(define-key KEYMAP [remap OLD] NEW])'. See also
2075 `substitute-key-definition', an older way of doing a similar thing. 2100 `substitute-key-definition', an older way of doing a similar thing.
2076 */ 2101 */
2077 (keymap, old, new_)) 2102 (keymap, old, new_))
2078 { 2103 {
2079 Lisp_Object cmd;
2080 Lisp_Key_Data parsed;
2081
2082 keymap = get_keymap (keymap, 1, 1); 2104 keymap = get_keymap (keymap, 1, 1);
2083 CHECK_COMMAND (old); 2105 CHECK_COMMAND (old);
2084 CHECK_COMMAND (new_); 2106 CHECK_COMMAND (new_);
2085 2107
2086 define_key_parser (Qxemacs_command_remapping, &parsed); 2108 return remap_command (keymap, old, new_);
2087 cmd = keymap_lookup_1 (keymap, &parsed, 0);
2088 if (NILP (cmd))
2089 {
2090 cmd = Fmake_sparse_keymap (Qnil);
2091 XKEYMAP (cmd)->name /* for debugging */
2092 = list2 (make_key_description (&parsed, 1), keymap);
2093 keymap_store (keymap, &parsed, cmd);
2094 }
2095
2096 assert (!NILP (Fkeymapp (cmd)));
2097 define_key_parser (old, &parsed);
2098 keymap_store (cmd, &parsed, new_);
2099 return new_;
2100 } 2109 }
2101 2110
2102 static Lisp_Object 2111 static Lisp_Object
2103 command_remapping (Lisp_Object definition, int nmaps, Lisp_Object *maps) 2112 command_remapping (Lisp_Object definition, int nmaps, Lisp_Object *maps)
2104 { 2113 {