Commits

Aidan Kehoe committed a81a739

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.

Comments (0)

Files changed (9)

 
 	* XEmacs 21.5.32 "habanero" is released.
 
+2012-09-02  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* help.el (describe-function-1):
+	Document any command remapping that has been done in this function.
+
 2012-05-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* byte-optimize.el (byte-optimize-letX):
 		       (global-tty-binding 
 			(where-is-internal function global-tty-map))
 		       (global-window-system-binding 
-			(where-is-internal function global-window-system-map)))
+			(where-is-internal function global-window-system-map))
+                       (command-remapping (command-remapping function))
+                       (commands-remapped-to (commands-remapped-to function)))
                    (if (or global-binding global-tty-binding
                            global-window-system-binding)
                        (if (and (equal global-binding
                              "\n%s\n        -- generally (that is, unless\
  overridden by TTY- or
            window-system-specific mappings)\n"
-                             (mapconcat #'key-description
-                                        global-binding
+                             (mapconcat #'key-description global-binding
                                         ", ")))))
-                     (princ (substitute-command-keys
-                             (format "\n\\[%s]" function))))))))))))
+                       (if command-remapping
+                           (progn
+                             (princ "Its keys are remapped to `")
+                             (princ (symbol-name command-remapping))
+                             (princ "'.\n"))
+                           (princ (substitute-command-keys
+                                   (format "\n\\[%s]" function))))
+                       (when commands-remapped-to
+                         (if (cdr commands-remapped-to)
+                             (princ (format "The following functions are \
+remapped to it:\n`%s'" (mapconcat #'prin1-to-string commands-remapped-to
+                                  "', `")))
+                           (princ (format "`%s' is remapped to it.\n"
+                                          (car
+                                           commands-remapped-to))))))))))))))
 
 ;;; [Obnoxious, whining people who complain very LOUDLY on Usenet
 ;;; are binding this to keys.]
 
 	* XEmacs 21.5.32 "habanero" is released.
 
+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.
+
 2012-05-06  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* lispref/macros.texi (Expansion):

man/lispref/keymaps.texi

 * Changing Key Bindings::    Redefining a key in a keymap.
 * Key Binding Commands::     Interactive interfaces for redefining keys.
 * Scanning Keymaps::         Looking through all keymaps, for printing help.
+* Remapping commands::       Specifying that one command should override
+                                another.
 * Other Keymap Functions::   Miscellaneous keymap functions.
 @end menu
 
 @var{olddef} is replaced with @var{newdef} wherever it appears.  Prefix
 keymaps are checked recursively.
 
-The function returns @code{nil}.
+The function returns @code{nil}.  @pxref{Remapping commands} for a more
+robust way of doing the same thing.
 
 For example, this redefines @kbd{C-x C-f}, if you do it in an XEmacs with
 standard bindings:
 displayed.
 @end deffn
 
+@node Remapping commands
+@section Remapping commands
+
+This section describes some functionality to allow commands to be
+remapped, e.g. when providing workalike commands.
+
+@defun remap-command keymap old new
+This function ensures that in @var{keymap} any command lookups that
+would previously have given @var{old} now give @var{new}.  This is
+equivalent to the following GNU-compatible code, which also works in
+XEmacs:
+
+@smallexample
+(define-key KEYMAP [remap OLD] NEW)
+@end smallexample
+@end defun
+
+@defun command-remapping command &optional position keymaps
+If @var{command} has a remapping in @var{keymaps}, this function returns
+that remapping.  Otherwise it returns @var{nil}.  @var{keymaps} defaults
+to the currently active keymaps. @var{position} specifies the relevant buffer
+position where keymaps should be searched for, and overrides
+@var{keymaps}.  It can also be a marker or an event.
+@end defun
+
+@defun commands-remapped-to command &optional position keymaps
+This is the inverse operation of @code{command-remapping}; it returns a
+list of the commands that will never be executed in @var{keymaps}
+because @var{command} will be execute instead.
+@end defun
+
 @node Other Keymap Functions
 @section Other Keymap Functions
 
 
 	* XEmacs 21.5.32 "habanero" is released.
 
+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.
+
 2012-05-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* minibuf.c (Ftest_completion):
 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,
 			  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;
 
 /* 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))
 `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
 
   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,
       }
     }
 }
-
+
+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                      */
 }
 
 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;
     }
 #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
   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;
    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;
   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;
 
 
   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;
 }
 
   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,
   /* 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);
 }
 
   /* 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))
 	}
     }
 
+  if (!NILP (command_remapping (definition, nmaps, gubbish)))
+    {
+      return Qnil;
+    }
+
   return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
 }
 
   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);
 	  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 (Qmodeline_map);
   DEFSYMBOL (Qtoolbar_map);
+  DEFSYMBOL (Qremap);
 
   DEFSUBR (Fkeymap_parents);
   DEFSUBR (Fset_keymap_parents);
   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);
 
   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
  while (NILP (Ffunctionp (fun)))		\
    signal_invalid_function_error (fun);		\
  } while (0)
+
+#define CHECK_COMMAND(x) do {                           \
+    if (NILP (Fcommandp (x)))                           \
+      {                                                 \
+        dead_wrong_type_argument (Qcommandp, x);        \
+      }                                                 \
+  } while (0)
 
 /************************************************************************/
 /*                      Parsing keyword arguments                       */
 
 	* XEmacs 21.5.32 "habanero" is released.
 
+2012-09-02  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/keymap-tests.el:
+	Test the new command remapping functionality.
+
 2012-05-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/mule-tests.el:

tests/automated/keymap-tests.el

+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Aidan Kehoe <kehoea@parhasard.net>
+;; Maintainers: Aidan Kehoe <kehoea@parhasard.net>
+;; Created: 2012
+;; Keywords: tests
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by the
+;; Free Software Foundation, either version 3 of the License, or (at your
+;; option) any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Synched up with: Not in FSF.
+
+(let* ((map (make-keymap 'help-map-copy))
+       (parent-map (make-keymap 'help-map-copy-parent))
+       (help-map-copy t)
+       (minor-mode-map-alist (acons 'help-map-copy map minor-mode-map-alist)))
+  (set-keymap-parent map parent-map)
+  (loop for (keys def) on '((shift tab) help-prev-symbol tab
+                            help-next-symbol c customize-variable V
+                            find-variable-at-point q
+                            help-mode-quit f find-function-at-point d
+                            describe-function-at-point v
+                            describe-variable-at-point i Info-elisp-ref F
+                            find-function-at-point Q help-mode-bury button2
+                            help-mouse-find-source-or-track p
+                            help-prev-section n help-next-section return
+                            help-find-source-or-scroll-up)
+        by #'cddr
+        do (define-key map (vector keys) def))
+  (loop for (keys def) on '(u view-scroll-some-lines-down % view-goto-percent
+                            \2 digit-argument p view-goto-percent \? 
+                            view-search-backward - negative-argument k
+                            view-scroll-lines-down backspace scroll-down G
+                            view-last-windowful f scroll-up \5
+                            digit-argument s view-repeat-search \0
+                            digit-argument n view-repeat-search = what-line
+                            \\ view-search-backward delete scroll-down \8
+                            digit-argument E view-file d
+                            view-scroll-some-lines-up \3 digit-argument q
+                            view-quit ! shell-command (control j)
+                            view-scroll-lines-up (control m)
+                            view-scroll-lines-up y view-scroll-lines-down
+                            linefeed view-scroll-lines-up g view-goto-line
+                            \6 digit-argument t toggle-truncate-lines C
+                            view-cleanup-backspaces b scroll-down \1
+                            digit-argument P view-buffer return
+                            view-scroll-lines-up | shell-command-on-region j
+                            view-scroll-lines-up \9 digit-argument \'
+                            register-to-point e view-scroll-lines-up \4
+                            digit-argument r recenter space scroll-up /
+                            view-search-forward N view-buffer m
+                            point-to-register h view-mode-describe \7
+                            digit-argument
+                            find-function-at-point view-mode-describe)
+        by #'cddr
+        do (define-key parent-map (vector keys) def))
+  (Assert (eq (key-binding [F]) 'find-function-at-point)
+          "checking normal key lookup works, F")
+  (Assert (eq (key-binding [c]) 'customize-variable)
+          "checking normal key lookup works, c")
+  (Assert (eq (key-binding [\2]) 'digit-argument)
+          "checking normal key parent lookup works, \\2")
+  (Assert (eq (key-binding [|]) 'shell-command-on-region)
+          "checking normal key parent lookup works, |")
+  (define-key map [remap find-function-at-point] #'find-file)
+  (Assert (eq (key-binding [F]) 'find-file)
+          "checking remapped key lookup works, F")
+  (Assert (eq (key-binding [f]) 'find-file)
+          "checking remapped key lookup works, f")
+  (Assert (eq (key-binding [\2]) 'digit-argument)
+          "checking normal key parent lookup works, \\2")
+  (Assert (eq (key-binding [|]) 'shell-command-on-region)
+          "checking normal key parent lookup works, |")
+  (Assert (eq (key-binding [find-function-at-point]) 'view-mode-describe)
+          "checking remapped function doesn't affect key name mapping")
+  (define-key parent-map [remap help-next-symbol] #'find-file)
+  (Assert (eq (key-binding [tab]) 'find-file)
+          "checking remapping in parent extends to child")
+  (Assert (equal (commands-remapped-to 'find-file)
+		 '(help-next-symbol find-function-at-point))
+	  "checking #'commands-remapped-to is sane")
+  (Check-Error wrong-type-argument (commands-remapped-to pi))
+  (Check-Error wrong-type-argument (commands-remapped-to 'find-file pi))
+  (Check-Error wrong-type-argument (commands-remapped-to 'find-file nil pi))
+  (Assert (eq (command-remapping 'find-function-at-point) 'find-file)
+	  "checking #'command-remapping is sane")
+  (Check-Error wrong-type-argument (command-remapping pi))
+  (Check-Error wrong-type-argument (command-remapping 'find-function-at-point
+						      pi))
+  (Check-Error wrong-type-argument (command-remapping 'find-function-at-point
+						      nil pi)))
+