Mercurial > hg > xemacs-beta
diff src/keymap.c @ 5679:a81a739181dc
Add command remapping, a more robust alternative to #'substitute-key-definition
src/ChangeLog addition:
2012-09-02 Aidan Kehoe <kehoea@parhasard.net>
* keymap.c:
Add command remapping, a more robust equivalent to
#'substitute-key-definition.
* keymap.c (CHECK_REMAPPING_POSITION): New.
* keymap.c (keymap_equal): Correct a comment here.
* keymap.c (Fdefine_key): Document the command remapping syntax.
* keymap.c (Fremap_command): New.
* keymap.c (command_remapping): New.
* keymap.c (Fcommand_remapping): New.
* keymap.c (commands_remapped_to_mapper): New.
* keymap.c (commands_remapped_to_traverser): New.
* keymap.c (Fcommands_remapped_to): New.
* keymap.c (get_relevant_keymaps): Take a new POSITION argument.
* keymap.c (Fcurrent_keymaps, event_binding):
Supply the new POSITION argument to get_relevant_keymaps.
* keymap.c (Fkey_binding):
Add new arguments, NO-REMAP and POSITION.
* keymap.c (map_keymap_mapper):
* keymap.c (Fwhere_is_internal):
* keymap.c (where_is_to_char):
* keymap.c (where_is_recursive_mapper):
Don't expose the key remapping in these functions. This conflicts
with GNU, but is more sane for our callers. Access to command
remapping is with the functions #'command-remapping,
#'commands-remapped-to, and #'remap-command, not with the general
keymap functions, apart from the compatibility hack in #'define-key.
* keymap.c (syms_of_keymap):
* keymap.c (vars_of_keymap):
* keymap.c (complex_vars_of_keymap):
* lisp.h: New CHECK_COMMAND macro.
man/ChangeLog addition:
2012-09-02 Aidan Kehoe <kehoea@parhasard.net>
* lispref/keymaps.texi (Keymaps):
* lispref/keymaps.texi (Changing Key Bindings):
* lispref/keymaps.texi (Scanning Keymaps):
* lispref/keymaps.texi (Remapping commands):
* lispref/keymaps.texi (XEmacs): New.
* lispref/keymaps.texi (Other Keymap Functions):
Document the new command remapping functionality in this file.
lisp/ChangeLog addition:
2012-09-02 Aidan Kehoe <kehoea@parhasard.net>
* help.el (describe-function-1):
Document any command remapping that has been done in this function.
tests/ChangeLog addition:
2012-09-02 Aidan Kehoe <kehoea@parhasard.net>
* automated/keymap-tests.el:
Test the new command remapping functionality.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 02 Sep 2012 14:31:40 +0100 |
parents | 56144c8593a8 |
children | 4af5a3435c94 |
line wrap: on
line diff
--- a/src/keymap.c Sun Aug 12 11:32:36 2012 +0100 +++ b/src/keymap.c Sun Sep 02 14:31:40 2012 +0100 @@ -188,9 +188,14 @@ Lisp_Object Qmodeline_map; Lisp_Object Qtoolbar_map; +Lisp_Object Qremap; +Lisp_Object Qxemacs_command_remapping; /* Uninterned, so there's no conflict + with any key named remap. */ + EXFUN (Fkeymap_fullness, 1); EXFUN (Fset_keymap_name, 2); EXFUN (Fsingle_key_description, 1); +EXFUN (Fremap_command, 3); static void describe_command (Lisp_Object definition, Lisp_Object buffer); static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, @@ -200,6 +205,14 @@ int mice_only_p, Lisp_Object buffer); static Lisp_Object keymap_submaps (Lisp_Object keymap); +static int get_relevant_keymaps (Lisp_Object, Lisp_Object, int, + Lisp_Object maps[]); +static Lisp_Object lookup_keys (Lisp_Object, int, Lisp_Object *, int); +static void map_keymap (Lisp_Object keymap_table, int sort_first, + void (*function) (const Lisp_Key_Data *key, + Lisp_Object binding, + void *fn_arg), + void *fn_arg); Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift; @@ -220,17 +233,21 @@ /* Kludge kludge kludge */ Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS; +#define CHECK_REMAPPING_POSITION(object) do \ + { \ + if (!(NILP (object) || FIXNUMP (object) || MARKERP (object) \ + || EVENTP (object))) \ + { \ + wtaerror ("Not a valid POSITION", object); \ + } \ + } while (0) + /************************************************************************/ /* The keymap Lisp object */ /************************************************************************/ -/* Keymaps are equal if Faces are equal if all of their display attributes are equal. We - don't compare names or doc-strings, because that would make equal - be eq. - - This isn't concerned with "unspecified" attributes, that's what - #'face-differs-from-default-p is for. */ +/* Keymaps are equal if all of their attributes are equal. */ static int keymap_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int UNUSED (foldcase)) @@ -1826,6 +1843,12 @@ `define-key' also accepts a number of abbreviations, aliases, and variants for convenience, compatibility, and internal use. +A key sequence can also be the vector [remap COMMAND]; this shadows any +bindings for COMMAND in KEYMAP, using DEF instead of COMMAND. See +`command-remapping' and `remap-command'. Specify [(remap) KEYSTROKE] if +your keyboard has a key with the name `remap' and you'd like to use it as a +prefix. + A keystroke may be represented by a key; this is treated as though it were a list containing that key as the only element. A keystroke may also be represented by an event object, as returned by the `next-command-event' and @@ -1916,6 +1939,12 @@ GCPRO3 (keymap, keys, def); + /* Allow access to any keys named remap, use our uninterned symbol. */ + if (2 == len && VECTORP (keys) && EQ (Qremap, XVECTOR_DATA (keys) [0])) + { + return Fremap_command (keymap, XVECTOR_DATA (keys) [1], def); + } + /* ASCII grunge. When the user defines a key which, in a strictly ASCII world, would be produced by two different keys (^J and linefeed, or ^H and backspace, @@ -2036,7 +2065,206 @@ } } } - + +DEFUN ("remap-command", Fremap_command, 3, 3, 0, /* +Ensure that NEW is called when previously OLD would be, in KEYMAP. + +NEW and OLD are both command symbols. KEYMAP is a keymap object. + +This is equivalent to `(define-key KEYMAP [remap OLD] NEW])'. See also +`substitute-key-definition', an older way of doing a similar thing. +*/ + (keymap, old, new_)) +{ + Lisp_Object cmd; + Lisp_Key_Data parsed; + + keymap = get_keymap (keymap, 1, 1); + CHECK_COMMAND (old); + CHECK_COMMAND (new_); + + define_key_parser (Qxemacs_command_remapping, &parsed); + cmd = keymap_lookup_1 (keymap, &parsed, 0); + if (NILP (cmd)) + { + cmd = Fmake_sparse_keymap (Qnil); + XKEYMAP (cmd)->name /* for debugging */ + = list2 (make_key_description (&parsed, 1), keymap); + keymap_store (keymap, &parsed, cmd); + } + + assert (!NILP (Fkeymapp (cmd))); + define_key_parser (old, &parsed); + keymap_store (cmd, &parsed, new_); + return new_; +} + +static Lisp_Object +command_remapping (Lisp_Object definition, int nmaps, Lisp_Object *maps) +{ + Lisp_Object remapping = Qnil; + Lisp_Object keys[2] = { Qxemacs_command_remapping, definition }; + int jj; + + for (jj = 0; jj < nmaps; jj++) + { + remapping = lookup_keys (maps[jj], countof (keys), keys, 0); + if (!NILP (remapping) && !FIXNUMP (remapping)) + { + return remapping; + } + } + + return Qnil; +} + +DEFUN ("command-remapping", Fcommand_remapping, 1, 3, 0, /* +Return the remapping for command COMMAND. + +Return nil if COMMAND is not remapped (or not a symbol). The remapping is +the command that is executed when some key sequence in the relevant keymaps +would normally execute COMMAND, but this has been intercepted by +`remap-command' or the [remap COMMAND] syntax for KEYS in `define-key'. + +If the optional argument POSITION is non-nil, it specifies an event, and the +remapping occurs in the keymaps associated with it. It can also be a number +or marker, in which case the keymap properties at the specified buffer +position instead of point are used. The KEYMAPS argument is ignored if +POSITION is non-nil. + +If the optional argument KEYMAPS is non-nil, it should be a list of +keymaps to search for command remapping. Otherwise, search for the +remapping in all currently active keymaps. +*/ + (command, position, keymaps)) +{ + Lisp_Object maps[100]; + Lisp_Object *gubbish = maps; + int nmaps, maps_count = countof (maps); + + CHECK_COMMAND (command); + CHECK_LIST (keymaps); + CHECK_REMAPPING_POSITION (position); + + /* Get keymaps as an array */ + if (NILP (keymaps) || !NILP (position)) + { + nmaps = get_relevant_keymaps (Qnil, position, maps_count, gubbish); + } + else + { + Elemcount jj = 0; + nmaps = XFIXNUM (Flength (keymaps)); + if (nmaps > maps_count) + { + gubbish = alloca_array (Lisp_Object, nmaps); + } + + { + LIST_LOOP_2 (elt, keymaps) + { + gubbish[jj++] = elt; + } + } + } + + if (nmaps > maps_count) + { + gubbish = alloca_array (Lisp_Object, nmaps); + nmaps = get_relevant_keymaps (Qnil, position, nmaps, gubbish); + } + + return command_remapping (command, nmaps, gubbish); +} + +struct commands_remapped_to_closure +{ + Lisp_Object command; + Lisp_Object result; +}; + +static void +commands_remapped_to_mapper (const Lisp_Key_Data *key, Lisp_Object binding, + void *data) +{ + struct commands_remapped_to_closure *crtc + = (struct commands_remapped_to_closure *) data; + + if (EQ (binding, crtc->command)) + { + crtc->result = Fcons (key->keysym, crtc->result); + } +} + +static Lisp_Object +commands_remapped_to_traverser (Lisp_Object k, void *arg) +{ + Lisp_Object remapping + = lookup_keys (k, 1, &Qxemacs_command_remapping, 0); + if (KEYMAPP (remapping)) + { + map_keymap (XKEYMAP (remapping)->table, 0, commands_remapped_to_mapper, + arg); + } + + return Qnil; +} + +DEFUN ("commands-remapped-to", Fcommands_remapped_to, 1, 3, 0, /* +Return a list of symbols for which COMMAND is their remapping in KEYMAPS. + +This is the inverse operation of `command-remapping', which see. +*/ + (command, keymaps, position)) +{ + Lisp_Object maps[100]; + Lisp_Object *gubbish = maps; + int nmaps, maps_count = countof (maps), jj; + struct commands_remapped_to_closure closure = { command, Qnil }; + struct gcpro gcpro1; + + CHECK_COMMAND (command); + CHECK_LIST (keymaps); + CHECK_REMAPPING_POSITION (position); + + /* Get keymaps as an array */ + if (NILP (keymaps) || !NILP (position)) + { + nmaps = get_relevant_keymaps (Qnil, position, maps_count, gubbish); + } + else + { + jj = 0; + nmaps = XFIXNUM (Flength (keymaps)); + if (nmaps > maps_count) + { + gubbish = alloca_array (Lisp_Object, nmaps); + } + + { + LIST_LOOP_2 (elt, keymaps) + { + gubbish[jj++] = elt; + } + } + } + + if (nmaps > maps_count) + { + gubbish = alloca_array (Lisp_Object, nmaps); + nmaps = get_relevant_keymaps (Qnil, position, nmaps, gubbish); + } + + GCPRO1 (closure.result); + + for (jj = 0; jj < nmaps; jj++) + { + traverse_keymaps (maps[jj], Qnil, commands_remapped_to_traverser, + (void *) (&closure)); + } + + RETURN_UNGCPRO (closure.result); +} /************************************************************************/ /* Looking up keys in keymaps */ @@ -2318,8 +2546,8 @@ } static int -get_relevant_keymaps (Lisp_Object keys, - int max_maps, Lisp_Object maps[]) +get_relevant_keymaps (Lisp_Object keys, Lisp_Object position, int max_maps, + Lisp_Object maps[]) { /* This function can GC */ Lisp_Object terminal = Qnil; @@ -2464,6 +2692,31 @@ } #endif /* HAVE_WINDOW_SYSTEM */ + if (FIXNUMP (position)) + { + get_relevant_extent_keymaps (position, wrap_buffer (current_buffer), + Qnil, &closure); + } + else if (MARKERP (position) && !NILP (Fmarker_buffer (position))) + { + get_relevant_extent_keymaps (Fmarker_position (position), + Fmarker_buffer (position), + Qnil, &closure); + } + else if (EVENTP (position)) + { + Lisp_Object ew = Fevent_window (position); + + get_relevant_extent_keymaps (Fevent_point (position), + WINDOWP (ew) ? + Fwindow_buffer (Fevent_window (position)) + : Qnil, Qnil, &closure); + } + else + { + assert (NILP (position)); + } + if (CONSOLE_TTY_P (con)) relevant_map_push (Vglobal_tty_map, &closure); else @@ -2580,23 +2833,34 @@ int nmaps; GCPRO1 (event_or_keys); - nmaps = get_relevant_keymaps (event_or_keys, countof (maps), + nmaps = get_relevant_keymaps (event_or_keys, Qnil, countof (maps), gubbish); if (nmaps > countof (maps)) { gubbish = alloca_array (Lisp_Object, nmaps); - nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); + nmaps = get_relevant_keymaps (event_or_keys, Qnil, nmaps, gubbish); } UNGCPRO; return Flist (nmaps, gubbish); } -DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /* +DEFUN ("key-binding", Fkey_binding, 1, 4, 0, /* Return the binding for command KEYS in current keymaps. + KEYS is a string, a vector of events, or a vector of key-description lists as described in the documentation for the `define-key' function. -The binding is probably a symbol with a function definition; see -the documentation for `lookup-key' for more information. + +NO-REMAP, if non-nil, specifies that any substitutions that have been +specified by `remap-command' (or, equivalently, by `(define-key KEYMAP +\[remap OLD] NEW)') should be ignored. + +POSITION, if non-nil, specifies a marker (and its associated buffer) or an +integer position (in the current buffer) to examine for relevant keymaps. +It can also be an event, in which case the associated buffer and position of +that event will be used. + +The binding is probably a symbol with a function definition; see the +documentation for `lookup-key' for more information. For key-presses, the order of keymaps searched is: - the `keymap' property of any extent(s) at point; @@ -2650,7 +2914,7 @@ generate and display a list of possible key sequences and bindings given the prefix so far generated. */ - (keys, accept_default)) + (keys, accept_default, no_remap, position)) { /* This function can GC */ int i; @@ -2659,7 +2923,7 @@ struct gcpro gcpro1, gcpro2; GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */ - nmaps = get_relevant_keymaps (keys, countof (maps), maps); + nmaps = get_relevant_keymaps (keys, position, countof (maps), maps); UNGCPRO; @@ -2668,15 +2932,19 @@ for (i = 0; i < nmaps; i++) { - Lisp_Object tem = Flookup_key (maps[i], keys, - accept_default); + Lisp_Object tem = Flookup_key (maps[i], keys, accept_default); + if (FIXNUMP (tem)) { /* Too long in some local map means don't look at global map */ return Qnil; } - else if (!NILP (tem)) - return tem; + + if (!NILP (tem) && NILP (no_remap) && SYMBOLP (tem)) + { + Lisp_Object remap = command_remapping (tem, nmaps, maps); + return NILP (remap) ? tem : remap; + } } return Qnil; } @@ -2724,7 +2992,7 @@ assert (EVENTP (event0)); - nmaps = get_relevant_keymaps (event0, countof (maps), maps); + nmaps = get_relevant_keymaps (event0, Qnil, countof (maps), maps); if (nmaps > countof (maps)) nmaps = countof (maps); return process_event_binding_result (lookup_events (event0, nmaps, maps, @@ -3024,6 +3292,13 @@ /* This function can GC */ Lisp_Object fn; fn = GET_LISP_FROM_VOID (function); + + /* Don't expose our remapping here. */ + if (EQ (KEY_DATA_KEYSYM (key), Qxemacs_command_remapping)) + { + return; + } + call2 (fn, make_key_description (key, 1), binding); } @@ -3483,12 +3758,12 @@ /* Get keymaps as an array */ if (NILP (keymaps)) { - nmaps = get_relevant_keymaps (event_or_keys, countof (maps), - gubbish); + nmaps = get_relevant_keymaps (event_or_keys, Qnil, countof (maps), + gubbish); if (nmaps > countof (maps)) { gubbish = alloca_array (Lisp_Object, nmaps); - nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); + nmaps = get_relevant_keymaps (event_or_keys, Qnil, nmaps, gubbish); } } else if (CONSP (keymaps)) @@ -3518,6 +3793,11 @@ } } + if (!NILP (command_remapping (definition, nmaps, gubbish))) + { + return Qnil; + } + return where_is_internal (definition, gubbish, nmaps, firstonly, 0); } @@ -3536,11 +3816,11 @@ int nmaps; /* Get keymaps as an array */ - nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish); + nmaps = get_relevant_keymaps (Qnil, Qnil, countof (maps), gubbish); if (nmaps > countof (maps)) { gubbish = alloca_array (Lisp_Object, nmaps); - nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish); + nmaps = get_relevant_keymaps (Qnil, Qnil, nmaps, gubbish); } where_is_internal (definition, maps, nmaps, Qt, buffer); @@ -3714,6 +3994,12 @@ continue; } + /* Don't expose the command remapping to #'where-is-internal */ + if (EQ (key, Qxemacs_command_remapping)) + { + continue; + } + /* If the map is a "bucky" map, then add a bit to the modifiers_so_far list. Otherwise, add a new raw_key onto the end of keys_so_far. @@ -4307,6 +4593,7 @@ DEFSYMBOL (Qmodeline_map); DEFSYMBOL (Qtoolbar_map); + DEFSYMBOL (Qremap); DEFSUBR (Fkeymap_parents); DEFSUBR (Fset_keymap_parents); @@ -4326,6 +4613,9 @@ DEFSUBR (Fmap_keymap); DEFSUBR (Fevent_matches_key_specifier_p); DEFSUBR (Fdefine_key); + DEFSUBR (Fremap_command); + DEFSUBR (Fcommands_remapped_to); + DEFSUBR (Fcommand_remapping); DEFSUBR (Flookup_key); DEFSUBR (Fkey_binding); DEFSUBR (Fuse_global_map); @@ -4455,6 +4745,10 @@ Vsingle_space_string = make_string ((const Ibyte *) " ", 1); staticpro (&Vsingle_space_string); + + Qxemacs_command_remapping + = Fmake_symbol (build_ascstring ("xemacs-command-remapping")); + staticpro (&Qxemacs_command_remapping); } void