Mercurial > hg > xemacs-beta
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 { |