xemacs-beta: src/keymap.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:b0d40183ac79
+:a81a739181dc
 Lisp_Object Vsingle_space_string;
 Lisp_Object Qsuppress_keymap;
 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,
 			  void (*elt_describer) (Lisp_Object, Lisp_Object),
 			  int partial,
 			  Lisp_Object shadow,
 			  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;
 #define INCLUDE_BUTTON_ZERO
 #define FROB(num)				\
 #include "keymap-buttons.h"
 /* 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
+/* Keymaps are equal if all of their attributes are equal. */
-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. */
 static int
 keymap_equal (Lisp_Object obj1, Lisp_Object obj2, int depth,
 	      int UNUSED (foldcase))
 {
 Lisp_Keymap *k1 = XKEYMAP (obj1);
 Besides the canonical representation as a vector of lists of symbols,
 `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
 `read-key-sequence' functions.  A key sequence may be represented by a
 single keystroke; this is treated as a vector containing that keystroke as
 }
 if (len == 0)
 return Qnil;
 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,
 for example) then the binding will be made for both keysyms.
 	keymap = get_keymap (cmd, 1, 1);
 NUNGCPRO;
 }
 }
 }
+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                      */
 /************************************************************************/
 closure->gcpro->nvars = nmaps;
 }
 }
 static int
-get_relevant_keymaps (Lisp_Object keys,
+get_relevant_keymaps (Lisp_Object keys, Lisp_Object position, int max_maps,
-int max_maps, Lisp_Object maps[])
+Lisp_Object maps[])
 {
 /* This function can GC */
 Lisp_Object terminal = Qnil;
 struct gcpro gcpro1;
 struct relevant_maps closure;
 	  if (!UNBOUNDP (map) && !NILP (map))
 	    relevant_map_push (map, &closure);
 	}
 }
 #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
 relevant_map_push (Vglobal_window_system_map, &closure);
 Lisp_Object maps[100];
 Lisp_Object *gubbish = maps;
 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;
 - any applicable minor-mode maps;
 - the current local map of the current-buffer;
 on the keycaps. (Not yet implemented)
 -- Finally, if the last keystroke matches `help-char', we automatically
 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;
 Lisp_Object maps[100];
 int nmaps;
 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;
 if (EVENTP (keys))           /* unadvertised "feature" for the future */
 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
 for (i = 0; i < nmaps; i++)
 {
-Lisp_Object tem = Flookup_key (maps[i], keys,
+Lisp_Object tem = Flookup_key (maps[i], keys, accept_default);
-				     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;
 }
 static Lisp_Object
 Lisp_Object maps[100];
 int nmaps;
 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,
 						      accept_default));
 }
 void *function)
 {
 /* 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);
 }
 static void
 int nmaps;
 /* Get keymaps as an array */
 if (NILP (keymaps))
 {
-nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
+nmaps = get_relevant_keymaps (event_or_keys, Qnil, countof (maps),
-				    gubbish);
+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))
 {
 Lisp_Object rest;
 if (!EQ (gubbish[0], Vcurrent_global_map))
 	{
 	  gubbish[1] = Vcurrent_global_map;
 	  nmaps++;
 	}
+}
+if (!NILP (command_remapping (definition, nmaps, gubbish)))
+{
+return Qnil;
 }
 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
 }
 Lisp_Object maps[100];
 Lisp_Object *gubbish = maps;
 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);
 }
 if (NILP (submap))
 	{
 	  XKEYMAP (map)->sub_maps_cache = Qt;
 	  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.
 	 */
 DEFSYMBOL (Qsuppress_keymap);
 DEFSYMBOL (Qmodeline_map);
 DEFSYMBOL (Qtoolbar_map);
+DEFSYMBOL (Qremap);
 DEFSUBR (Fkeymap_parents);
 DEFSUBR (Fset_keymap_parents);
 DEFSUBR (Fkeymap_name);
 DEFSUBR (Fset_keymap_name);
 DEFSUBR (Fcopy_keymap);
 DEFSUBR (Fkeymap_fullness);
 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);
 DEFSUBR (Fuse_local_map);
 DEFSUBR (Fcurrent_local_map);
 staticpro (&Vcurrent_global_map);
 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
 complex_vars_of_keymap (void)
 {

Mercurial > hg > xemacs-beta

comparison src/keymap.c @ 5679:a81a739181dc