Updated Patch for command remapping through keymaps

[Kim F. Storm]

Thanks to Richard and Eli for comments on my previous patch.
I've tried to accomodate all of your comments, and I have
reorganized some of the code to make it easier to explain
(and understand - I hope).

Here is an updated patch for your review.

Index: etc/NEWS
===================================================================
RCS file: /cvs/emacs/etc/NEWS,v
retrieving revision 1.586
diff -c -r1.586 NEWS
*** etc/NEWS    2 Feb 2002 13:12:45 -0000       1.586
--- etc/NEWS    3 Feb 2002 01:14:37 -0000
***************
*** 130,135 ****
--- 130,156 ----
  The info-search bindings on C-h C-f, C-h C-k and C-h C-i
  have been moved to C-h F, C-h K and C-h S.
  
+ C-h c, C-h k, C-h w, and C-h f now handle remapped interactive commands.
+ 
+ - C-h c and C-h k report the actual command (after possible remapping)
+   run by the key sequence.
+ 
+ - C-h w and C-h f on a command which has been remapped now report the
+   command it is remapped to, and the keys which can be used to run
+   that command.
+ 
+ For example, if kill-line is bound to C-k, and kill-line is remapped
+ to new-kill-line, these commands now report: 
+ 
+ - C-h c and C-h k C-k reports:
+   C-k runs the command new-kill-line
+ 
+ - C-h w and C-h f kill-line reports:
+   kill-line is remapped to new-kill-line which is on C-k, <deleteline>
+ 
+ - C-h w and C-h f new-kill-line reports:
+   new-kill-line is on C-k
+ 
  ** C-w in incremental search now grabs either a character or a word,
  making the decision in a heuristic way.  This new job is done by the
  command `isearch-yank-word-or-char'.  To restore the old behavior,
***************
*** 409,414 ****
--- 430,495 ----
  
  
  * Lisp Changes in Emacs 21.3
+ 
+ ** Interactive commands can be remapped through keymaps.
+ 
+ This is an alternative to using defadvice or substitute-key-definition
+ to modify the behaviour of a key binding using the normal keymap
+ binding and lookup functionality.
+ 
+ When a key sequence is bound to a command, and that command is
+ remapped to another command, that command is run instead of the
+ original command.
+ 
+ Example:
+ Suppose that minor mode my-mode has defined the commands
+ my-kill-line and my-kill-word, and it wants C-k (and any other key
+ bound to kill-line) to run the command my-kill-line instead of
+ kill-line, and likewise it wants to run my-kill-word instead of
+ kill-word.
+ 
+ Instead of rebinding C-k and the other keys in the minor mode map,
+ command remapping allows you to directly map kill-line into
+ my-kill-line and kill-word into my-kill-word through the minor mode
+ map using define-key:
+ 
+    (define-key my-mode-map 'kill-line 'my-kill-line)
+    (define-key my-mode-map 'kill-word 'my-kill-word)
+ 
+ Now, when my-mode is enabled, and the user enters C-k or M-d,
+ the commands my-kill-line and my-kill-word are run.
+ 
+ Notice that only one level of remapping is supported.  In the above
+ example, this means that if my-kill-line is remapped to other-kill,
+ then C-k still runs my-kill-line.
+ 
+ The following changes have been made to provide command remapping:
+ 
+ - define-key now accepts a command name as the KEY argument.
+   This identifies the command to be remapped in the specified keymap.
+   This is equivalent to specifying the command name as the only
+   element of a vector, e.g [kill-line].
+ 
+ - global-set-key, global-unset-key, local-set-key, and local-unset-key
+   also accept a command name as the KEY argument.
+ 
+ - key-binding now remaps interactive commands unless the optional
+   third argument NO-REMAP is non-nil.  It also accepts a command name
+   as the KEY argument.
+ 
+ - lookup-key now accepts a command name as the KEY argument.
+ 
+ - where-is-internal now returns nil for a remapped command (e.g.
+   kill-line if my-mode is enabled), and the actual key binding for
+   the command it is remapped to (e.g. C-k for my-kill-line).
+   It also has a new optional fifth argument, NO-REMAP, which inhibits
+   remapping if non-nil (e.g. it returns C-k for kill-line and
+   <kill-line> for my-kill-line).
+ 
+ - The new variable `this-original-command' contains the original
+   command before remapping.  It is equal to `this-command' when the
+   command was not remapped.
+ 
  
  ** New function substring-no-properties.
  
Index: lisp/help-fns.el
===================================================================
RCS file: /cvs/emacs/lisp/help-fns.el,v
retrieving revision 1.5
diff -c -r1.5 help-fns.el
*** lisp/help-fns.el    7 Jan 2002 05:20:33 -0000       1.5
--- lisp/help-fns.el    3 Feb 2002 01:14:37 -0000
***************
*** 207,218 ****
      (princ ".")
      (terpri)
      (when (commandp function)
!       (let ((keys (where-is-internal
!                  function overriding-local-map nil nil)))
        (when keys
!         (princ "It is bound to ")
          ;; FIXME: This list can be very long (f.ex. for self-insert-command).
!         (princ (mapconcat 'key-description keys ", "))
          (princ ".")
          (terpri))))
      ;; Handle symbols aliased to other symbols.
--- 207,226 ----
      (princ ".")
      (terpri)
      (when (commandp function)
!       (let* ((binding (and (symbolp function) (commandp function)
!                          (key-binding function nil t)))
!            (remapped (and (symbolp binding) (commandp binding) binding))
!            (keys (where-is-internal
!                  (or remapped function) overriding-local-map nil nil)))
!       (when remapped
!         (princ "It is remapped to `")
!         (princ (symbol-name remapped))
!         (princ "'"))
        (when keys
!         (princ (if remapped " which is bound to " "It is bound to "))
          ;; FIXME: This list can be very long (f.ex. for self-insert-command).
!         (princ (mapconcat 'key-description keys ", ")))
!       (when (or remapped keys)
          (princ ".")
          (terpri))))
      ;; Handle symbols aliased to other symbols.
Index: lisp/help.el
===================================================================
RCS file: /cvs/emacs/lisp/help.el,v
retrieving revision 1.243
diff -c -r1.243 help.el
*** lisp/help.el        17 Jan 2002 01:40:47 -0000      1.243
--- lisp/help.el        3 Feb 2002 01:14:37 -0000
***************
*** 412,426 ****
       (list (if (equal val "")
               fn (intern val))
           current-prefix-arg)))
!   (let* ((keys (where-is-internal definition overriding-local-map nil nil))
         (keys1 (mapconcat 'key-description keys ", "))
         (standard-output (if insert (current-buffer) t)))
      (if insert
        (if (> (length keys1) 0)
!           (princ (format "%s (%s)" keys1 definition))
          (princ (format "M-x %s RET" definition)))
        (if (> (length keys1) 0)
!         (princ (format "%s is on %s" definition keys1))
        (princ (format "%s is not on any key" definition)))))
    nil)
  
--- 412,433 ----
       (list (if (equal val "")
               fn (intern val))
           current-prefix-arg)))
!   (let* ((binding (and (symbolp definition) (commandp definition)
!                      (key-binding definition nil t)))
!        (remap (and (symbolp binding) (commandp binding) binding))
!        (keys (where-is-internal definition overriding-local-map nil nil 
remap))
         (keys1 (mapconcat 'key-description keys ", "))
         (standard-output (if insert (current-buffer) t)))
      (if insert
        (if (> (length keys1) 0)
!           (if remap
!               (princ (format "%s (%s) (remapped from %s)" keys1 remap 
definition))
!             (princ (format "%s (%s)" keys1 definition)))
          (princ (format "M-x %s RET" definition)))
        (if (> (length keys1) 0)
!         (if remap
!             (princ (format "%s is remapped to %s which is on %s" definition 
remap keys1))
!           (princ (format "%s is on %s" definition keys1)))
        (princ (format "%s is not on any key" definition)))))
    nil)
  
Index: lisp/subr.el
===================================================================
RCS file: /cvs/emacs/lisp/subr.el,v
retrieving revision 1.284
diff -c -r1.284 subr.el
*** lisp/subr.el        25 Jan 2002 05:05:16 -0000      1.284
--- lisp/subr.el        3 Feb 2002 01:14:38 -0000
***************
*** 1571,1577 ****
  that local binding will continue to shadow any global binding
  that you make with this function."
    (interactive "KSet key globally: \nCSet key %s to command: ")
!   (or (vectorp key) (stringp key)
        (signal 'wrong-type-argument (list 'arrayp key)))
    (define-key (current-global-map) key command))
  
--- 1571,1577 ----
  that local binding will continue to shadow any global binding
  that you make with this function."
    (interactive "KSet key globally: \nCSet key %s to command: ")
!   (or (vectorp key) (stringp key) (symbolp key)
        (signal 'wrong-type-argument (list 'arrayp key)))
    (define-key (current-global-map) key command))
  
***************
*** 1589,1595 ****
    (let ((map (current-local-map)))
      (or map
        (use-local-map (setq map (make-sparse-keymap))))
!     (or (vectorp key) (stringp key)
        (signal 'wrong-type-argument (list 'arrayp key)))
      (define-key map key command)))
  
--- 1589,1595 ----
    (let ((map (current-local-map)))
      (or map
        (use-local-map (setq map (make-sparse-keymap))))
!     (or (vectorp key) (stringp key) (symbolp key)
        (signal 'wrong-type-argument (list 'arrayp key)))
      (define-key map key command)))
  
Index: src/doc.c
===================================================================
RCS file: /cvs/emacs/src/doc.c,v
retrieving revision 1.89
diff -c -r1.89 doc.c
*** src/doc.c   22 Dec 2001 13:59:08 -0000      1.89
--- src/doc.c   3 Feb 2002 01:14:39 -0000
***************
*** 671,677 ****
  
          /* Note the Fwhere_is_internal can GC, so we have to take
             relocation of string contents into account.  */
!         tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
          strp = XSTRING (string)->data + idx;
          start = XSTRING (string)->data + start_idx;
  
--- 671,677 ----
  
          /* Note the Fwhere_is_internal can GC, so we have to take
             relocation of string contents into account.  */
!         tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
          strp = XSTRING (string)->data + idx;
          start = XSTRING (string)->data + start_idx;
  
Index: src/keyboard.c
===================================================================
RCS file: /cvs/emacs/src/keyboard.c,v
retrieving revision 1.652
diff -c -r1.652 keyboard.c
*** src/keyboard.c      2 Feb 2002 10:09:38 -0000       1.652
--- src/keyboard.c      3 Feb 2002 01:14:41 -0000
***************
*** 373,378 ****
--- 373,382 ----
  /* This is like Vthis_command, except that commands never set it.  */
  Lisp_Object real_this_command;
  
+ /* If the lookup of the command returns a binding, the original
+    command is stored in this-original-command.  It is nil otherwise.  */
+ Lisp_Object Vthis_original_command;
+ 
  /* The value of point when the last command was executed.  */
  int last_point_position;
  
***************
*** 1503,1508 ****
--- 1507,1523 ----
         reset it before we execute the command. */
        Vdeactivate_mark = Qnil;
  
+       /* Remap command through active keymaps */
+       Vthis_original_command = cmd;
+       if (is_command_symbol (cmd))
+       {
+         Lisp_Object cmd1;
+ 
+         cmd1 = Fkey_binding (cmd, Qnil, Qt);
+         if (!NILP (cmd1) && is_command_symbol (cmd1))
+           cmd = cmd1;
+       }
+ 
        /* Execute the command.  */
  
        Vthis_command = cmd;
***************
*** 6947,6953 ****
        Lisp_Object prefix;
  
        if (!NILP (tem))
!       tem = Fkey_binding (tem, Qnil);
  
        prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
        if (CONSP (prefix))
--- 6962,6968 ----
        Lisp_Object prefix;
  
        if (!NILP (tem))
!       tem = Fkey_binding (tem, Qnil, Qnil);
  
        prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
        if (CONSP (prefix))
***************
*** 6993,6999 ****
              && SYMBOLP (XSYMBOL (def)->function)
              && ! NILP (Fget (def, Qmenu_alias)))
            def = XSYMBOL (def)->function;
!         tem = Fwhere_is_internal (def, Qnil, Qt, Qnil);
          XSETCAR (cachelist, tem);
          if (NILP (tem))
            {
--- 7008,7014 ----
              && SYMBOLP (XSYMBOL (def)->function)
              && ! NILP (Fget (def, Qmenu_alias)))
            def = XSYMBOL (def)->function;
!         tem = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qt);
          XSETCAR (cachelist, tem);
          if (NILP (tem))
            {
***************
*** 9408,9414 ****
        && NILP (Vexecuting_macro)
        && SYMBOLP (function))
      bindings = Fwhere_is_internal (function, Voverriding_local_map,
!                                  Qt, Qnil);
    else
      bindings = Qnil;
  
--- 9423,9429 ----
        && NILP (Vexecuting_macro)
        && SYMBOLP (function))
      bindings = Fwhere_is_internal (function, Voverriding_local_map,
!                                  Qt, Qnil, Qnil);
    else
      bindings = Qnil;
  
***************
*** 10634,10639 ****
--- 10649,10660 ----
  The command can set this variable; whatever is put here
  will be in `last-command' during the following command.  */);
    Vthis_command = Qnil;
+ 
+   DEFVAR_LISP ("this-original-command", &Vthis_original_command,
+              doc: /* If non-nil, the original command bound to the current 
key sequence.
+ The value of `this-command' is the result of looking up the original
+ command in the active keymaps.  */);
+   Vthis_original_command = Qnil;
  
    DEFVAR_INT ("auto-save-interval", &auto_save_interval,
              doc: /* *Number of input events between auto-saves.
Index: src/keymap.c
===================================================================
RCS file: /cvs/emacs/src/keymap.c,v
retrieving revision 1.254
diff -c -r1.254 keymap.c
*** src/keymap.c        3 Jan 2002 21:28:04 -0000       1.254
--- src/keymap.c        3 Feb 2002 01:14:42 -0000
***************
*** 954,963 ****
  
  DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
         doc: /* Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as 
DEF.
! KEYMAP is a keymap.  KEY is a string or a vector of symbols and characters
! meaning a sequence of keystrokes and events.
! Non-ASCII characters with codes above 127 (such as ISO Latin-1)
! can be included if you use a vector.
  DEF is anything that can be a key's definition:
   nil (means key is undefined in this keymap),
   a command (a Lisp function suitable for interactive calling)
--- 954,965 ----
  
  DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
         doc: /* Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as 
DEF.
! KEYMAP is a keymap.
! 
! KEY is a string or a vector of symbols and characters meaning a
! sequence of keystrokes and events.  Non-ASCII characters with codes
! above 127 (such as ISO Latin-1) can be included if you use a vector.
! 
  DEF is anything that can be a key's definition:
   nil (means key is undefined in this keymap),
   a command (a Lisp function suitable for interactive calling)
***************
*** 971,977 ****
   or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
  
  If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at
! the front of KEYMAP.  */)
       (keymap, key, def)
       Lisp_Object keymap;
       Lisp_Object key;
--- 973,982 ----
   or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
  
  If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at
! the front of KEYMAP.  
! 
! KEY may also be a command name which is remapped to DEF.  In this case,
! DEF must be a symbol or nil (to remove a previous binding of KEY).  */)
       (keymap, key, def)
       Lisp_Object keymap;
       Lisp_Object key;
***************
*** 987,994 ****
  
    keymap = get_keymap (keymap, 1, 1);
  
!   if (!VECTORP (key) && !STRINGP (key))
!     key = wrong_type_argument (Qarrayp, key);
  
    length = XFASTINT (Flength (key));
    if (length == 0)
--- 992,1015 ----
  
    keymap = get_keymap (keymap, 1, 1);
  
!   if (SYMBOLP (key))
!     {
!       /* A command may only be remapped to another command.  */
! 
!       /* It would probably be more correct to use is_command_symbol
!        above and below instead of SYMBOLP, since remapping only
!        works for sych symbols.  However, to make that a requirement
!        would make it impossible to remap a command before it has
!        been defined.  So if a minor mode were to remap a command of
!        another minor mode which has not yet been loaded, it would
!        fail.  So use the least restrictive sanity check here.  */
!       if (!SYMBOLP (def))
!       key = wrong_type_argument (Qsymbolp, def);
!       else
!       key = Fmake_vector (make_number (1), key);
!     }
!   else if (!VECTORP (key) && !STRINGP (key))
!       key = wrong_type_argument (Qarrayp, key);
  
    length = XFASTINT (Flength (key));
    if (length == 0)
***************
*** 1084,1089 ****
--- 1105,1117 ----
  
    keymap = get_keymap (keymap, 1, 1);
  
+   if (SYMBOLP (key))
+     {
+       GCPRO1 (key);
+       cmd = access_keymap (keymap, key, t_ok, 0, 1);
+       RETURN_UNGCPRO (cmd);
+     }
+ 
    if (!VECTORP (key) && !STRINGP (key))
      key = wrong_type_argument (Qarrayp, key);
  
***************
*** 1361,1369 ****
    return keymaps;
  }
  
  /* GC is possible in this function if it autoloads a keymap.  */
  
! DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
         doc: /* Return the binding for command KEY in current keymaps.
  KEY is a string or vector, a sequence of keystrokes.
  The binding is probably a symbol with a function definition.
--- 1389,1432 ----
    return keymaps;
  }
  
+ /* Like Fcommandp, but looks specifically for a command symbol, and
+    doesn't signal errors.  Returns 1 if FUNCTION is a command symbol.  */
+ int
+ is_command_symbol (function)
+      Lisp_Object function;
+ {
+   if (!SYMBOLP (function) || EQ (function, Qunbound))
+     return 0;
+ 
+   function = indirect_function (function);
+   if (SYMBOLP (function) && EQ (function, Qunbound))
+     return 0;
+ 
+   if (SUBRP (function))
+     return (XSUBR (function)->prompt != 0);
+ 
+   if (COMPILEDP (function))
+     return ((ASIZE (function) & PSEUDOVECTOR_SIZE_MASK) > 
COMPILED_INTERACTIVE);
+   
+   if (CONSP (function))
+     {
+       Lisp_Object funcar;
+ 
+       funcar = Fcar (function);
+       if (SYMBOLP (funcar))
+       {
+         if (EQ (funcar, Qlambda))
+           return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (function))));
+         if (EQ (funcar, Qautoload))
+           return !NILP (Fcar (Fcdr (Fcdr (Fcdr (function)))));
+       }
+     }
+   return 0;
+ }
+ 
  /* GC is possible in this function if it autoloads a keymap.  */
  
! DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0,
         doc: /* Return the binding for command KEY in current keymaps.
  KEY is a string or vector, a sequence of keystrokes.
  The binding is probably a symbol with a function definition.
***************
*** 1372,1380 ****
  bindings, used when nothing else in the keymap applies; this makes it
  usable as a general function for probing keymaps.  However, if the
  optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
! recognize the default bindings, just as `read-key-sequence' does.  */)
!      (key, accept_default)
!      Lisp_Object key, accept_default;
  {
    Lisp_Object *maps, value;
    int nmaps, i;
--- 1435,1448 ----
  bindings, used when nothing else in the keymap applies; this makes it
  usable as a general function for probing keymaps.  However, if the
  optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
! recognize the default bindings, just as `read-key-sequence' does.
! 
! Like the normal command loop, `key-binding' will remap the command
! resulting from looking up KEY by looking up the command in the
! currrent keymaps.  However, if the optional third argument NO-REMAP
! is non-nil, `key-binding' returns the unmapped command.  */)
!      (key, accept_default, no_remap)
!      Lisp_Object key, accept_default, no_remap;
  {
    Lisp_Object *maps, value;
    int nmaps, i;
***************
*** 1387,1399 ****
        value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
                           key, accept_default);
        if (! NILP (value) && !INTEGERP (value))
!       RETURN_UNGCPRO (value);
      }
    else if (!NILP (Voverriding_local_map))
      {
        value = Flookup_key (Voverriding_local_map, key, accept_default);
        if (! NILP (value) && !INTEGERP (value))
!       RETURN_UNGCPRO (value);
      }
    else
      { 
--- 1455,1467 ----
        value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
                           key, accept_default);
        if (! NILP (value) && !INTEGERP (value))
!       goto done;
      }
    else if (!NILP (Voverriding_local_map))
      {
        value = Flookup_key (Voverriding_local_map, key, accept_default);
        if (! NILP (value) && !INTEGERP (value))
!       goto done;
      }
    else
      { 
***************
*** 1404,1410 ****
        {
          value = Flookup_key (local, key, accept_default);
          if (! NILP (value) && !INTEGERP (value))
!           RETURN_UNGCPRO (value);
        }
  
        nmaps = current_minor_maps (0, &maps);
--- 1472,1478 ----
        {
          value = Flookup_key (local, key, accept_default);
          if (! NILP (value) && !INTEGERP (value))
!           goto done;
        }
  
        nmaps = current_minor_maps (0, &maps);
***************
*** 1416,1422 ****
          {
            value = Flookup_key (maps[i], key, accept_default);
            if (! NILP (value) && !INTEGERP (value))
!             RETURN_UNGCPRO (value);
          }
  
        local = get_local_map (PT, current_buffer, Qlocal_map);
--- 1484,1490 ----
          {
            value = Flookup_key (maps[i], key, accept_default);
            if (! NILP (value) && !INTEGERP (value))
!             goto done;
          }
  
        local = get_local_map (PT, current_buffer, Qlocal_map);
***************
*** 1424,1439 ****
        {
          value = Flookup_key (local, key, accept_default);
          if (! NILP (value) && !INTEGERP (value))
!           RETURN_UNGCPRO (value);
        }
      }
  
    value = Flookup_key (current_global_map, key, accept_default);
    UNGCPRO;
!   if (! NILP (value) && !INTEGERP (value))
!     return value;
    
!   return Qnil;
  }
  
  /* GC is possible in this function if it autoloads a keymap.  */
--- 1492,1521 ----
        {
          value = Flookup_key (local, key, accept_default);
          if (! NILP (value) && !INTEGERP (value))
!           goto done;
        }
      }
  
    value = Flookup_key (current_global_map, key, accept_default);
+ 
+  done:
    UNGCPRO;
!   if (NILP (value) || INTEGERP (value))
!     return Qnil;
! 
!   /* If the result of the ordinary keymap lookup is an interactive
!      command, look for a key binding (ie. remapping) for that command.  */
!      
!   if (NILP (no_remap) && is_command_symbol (value))
!     {
!       Lisp_Object value1;
! 
!       value1 = Fkey_binding(value, accept_default, Qt);
!       if (!NILP (value1) && is_command_symbol (value1))
!       value = value1;
!     }
    
!   return value;
  }
  
  /* GC is possible in this function if it autoloads a keymap.  */
***************
*** 2156,2161 ****
--- 2238,2244 ----
  
  /* where-is - finding a command in a set of keymaps.                  */
  
+ static Lisp_Object where_is_internal ();
  static Lisp_Object where_is_internal_1 ();
  static void where_is_internal_2 ();
  
***************
*** 2180,2188 ****
  /* This function can GC if Flookup_key autoloads any keymaps.  */
  
  static Lisp_Object
! where_is_internal (definition, keymaps, firstonly, noindirect)
       Lisp_Object definition, keymaps;
!      Lisp_Object firstonly, noindirect;
  {
    Lisp_Object maps = Qnil;
    Lisp_Object found, sequences;
--- 2263,2271 ----
  /* This function can GC if Flookup_key autoloads any keymaps.  */
  
  static Lisp_Object
! where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
       Lisp_Object definition, keymaps;
!      Lisp_Object firstonly, noindirect, no_remap;
  {
    Lisp_Object maps = Qnil;
    Lisp_Object found, sequences;
***************
*** 2190,2195 ****
--- 2273,2284 ----
    /* 1 means ignore all menu bindings entirely.  */
    int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
  
+   /* If this command is remapped, then it has no key bindings
+      of its own.  */
+   if (NILP (no_remap)
+       && !NILP (Fkey_binding (definition, Qnil, Qt)))
+     return Qnil;
+ 
    found = keymaps;
    while (CONSP (found))
      {
***************
*** 2295,2305 ****
            }
  
  
!         for (; !NILP (sequences); sequences = XCDR (sequences))
            {
              Lisp_Object sequence;
  
              sequence = XCAR (sequences);
  
              /* Verify that this key binding is not shadowed by another
                 binding for the same key, before we say it exists.
--- 2384,2424 ----
            }
  
  
!         while (!NILP (sequences))
            {
              Lisp_Object sequence;
+             Lisp_Object remapped;
  
              sequence = XCAR (sequences);
+             sequences = XCDR (sequences);
+ 
+             /* If the current sequence is of the form [command],
+                this may be a remapped command, so look for the key
+                sequences which run that command, and return those
+                sequences instead.  */
+             remapped = Qnil;
+             if (NILP (no_remap)
+                 && VECTORP (sequence) && XVECTOR (sequence)->size == 1)
+               {
+                 Lisp_Object function;
+ 
+                 function = AREF (sequence, 0);
+                 if (is_command_symbol (function))
+                   {
+                     Lisp_Object remapped1;
+                     remapped1 = where_is_internal (function, keymaps, 
firstonly, noindirect, Qt);
+                     if (CONSP (remapped1))
+                       {
+                         /* Verify that this key binding actually maps to the
+                            remapped command (see below).  */
+                         if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), 
Qnil), function))
+                           continue;
+                         sequence = XCAR (remapped1);
+                         remapped = XCDR (remapped1);
+                         goto record_sequence;
+                       }
+                   }
+               }
  
              /* Verify that this key binding is not shadowed by another
                 binding for the same key, before we say it exists.
***************
*** 2313,2318 ****
--- 2432,2438 ----
              if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
                continue;
  
+           record_sequence:
              /* It is a true unshadowed match.  Record it, unless it's already
                 been seen (as could happen when inheriting keymaps).  */
              if (NILP (Fmember (sequence, found)))
***************
*** 2326,2331 ****
--- 2446,2458 ----
                RETURN_UNGCPRO (sequence);
              else if (!NILP (firstonly) && ascii_sequence_p (sequence))
                RETURN_UNGCPRO (sequence);
+ 
+             if (CONSP (remapped))
+               {
+                 sequence = XCAR (remapped);
+                 remapped = XCDR (remapped);
+                 goto record_sequence;
+               }
            }
        }
      }
***************
*** 2343,2349 ****
    return found;
  }
  
! DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
         doc: /* Return list of keys that invoke DEFINITION.
  If KEYMAP is non-nil, search only KEYMAP and the global keymap.
  If KEYMAP is nil, search all the currently active keymaps.
--- 2470,2476 ----
    return found;
  }
  
! DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
         doc: /* Return list of keys that invoke DEFINITION.
  If KEYMAP is non-nil, search only KEYMAP and the global keymap.
  If KEYMAP is nil, search all the currently active keymaps.
***************
*** 2358,2367 ****
  
  If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
  to other keymaps or slots.  This makes it possible to search for an
! indirect definition itself.  */)
!      (definition, keymap, firstonly, noindirect)
       Lisp_Object definition, keymap;
!      Lisp_Object firstonly, noindirect;
  {
    Lisp_Object sequences, keymaps;
    /* 1 means ignore all menu bindings entirely.  */
--- 2485,2498 ----
  
  If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
  to other keymaps or slots.  This makes it possible to search for an
! indirect definition itself.
! 
! If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
! that invoke a command which is remapped to DEFINITION, but include the
! remapped command in the returned list.  */)
!      (definition, keymap, firstonly, noindirect, no_remap)
       Lisp_Object definition, keymap;
!      Lisp_Object firstonly, noindirect, no_remap;
  {
    Lisp_Object sequences, keymaps;
    /* 1 means ignore all menu bindings entirely.  */
***************
*** 2382,2388 ****
      {
        Lisp_Object *defns;
        int i, j, n;
!       struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
        
        /* Check heuristic-consistency of the cache.  */
        if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
--- 2513,2519 ----
      {
        Lisp_Object *defns;
        int i, j, n;
!       struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
        
        /* Check heuristic-consistency of the cache.  */
        if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
***************
*** 2396,2403 ****
          where_is_cache_keymaps = Qt;
          
          /* Fill in the cache.  */
!         GCPRO4 (definition, keymaps, firstonly, noindirect);
!         where_is_internal (definition, keymaps, firstonly, noindirect);
          UNGCPRO;
  
          where_is_cache_keymaps = keymaps;
--- 2527,2534 ----
          where_is_cache_keymaps = Qt;
          
          /* Fill in the cache.  */
!         GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
!         where_is_internal (definition, keymaps, firstonly, noindirect, 
no_remap);
          UNGCPRO;
  
          where_is_cache_keymaps = keymaps;
***************
*** 2434,2440 ****
        /* Kill the cache so that where_is_internal_1 doesn't think
         we're filling it up.  */
        where_is_cache = Qnil;
!       result = where_is_internal (definition, keymaps, firstonly, noindirect);
      }
  
    return result;
--- 2565,2571 ----
        /* Kill the cache so that where_is_internal_1 doesn't think
         we're filling it up.  */
        where_is_cache = Qnil;
!       result = where_is_internal (definition, keymaps, firstonly, noindirect, 
no_remap);
      }
  
    return result;
Index: src/keymap.h
===================================================================
RCS file: /cvs/emacs/src/keymap.h,v
retrieving revision 1.3
diff -c -r1.3 keymap.h
*** src/keymap.h        19 Nov 2001 22:46:29 -0000      1.3
--- src/keymap.h        3 Feb 2002 01:14:42 -0000
***************
*** 28,37 ****
  EXFUN (Fkeymap_prompt, 1);
  EXFUN (Fdefine_key, 3);
  EXFUN (Flookup_key, 3);
! EXFUN (Fkey_binding, 2);
  EXFUN (Fkey_description, 1);
  EXFUN (Fsingle_key_description, 2);
! EXFUN (Fwhere_is_internal, 4);
  extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int, 
int));
  extern Lisp_Object get_keyelt P_ ((Lisp_Object, int));
  extern Lisp_Object get_keymap P_ ((Lisp_Object, int, int));
--- 28,38 ----
  EXFUN (Fkeymap_prompt, 1);
  EXFUN (Fdefine_key, 3);
  EXFUN (Flookup_key, 3);
! EXFUN (Fkey_binding, 3);
  EXFUN (Fkey_description, 1);
  EXFUN (Fsingle_key_description, 2);
! EXFUN (Fwhere_is_internal, 5);
! extern int is_command_symbol P_ ((Lisp_Object));
  extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int, 
int));
  extern Lisp_Object get_keyelt P_ ((Lisp_Object, int));
  extern Lisp_Object get_keymap P_ ((Lisp_Object, int, int));

-- 
Kim F. Storm <address@hidden> http://www.cua.dk