[Emacs-diffs] Changes to emacs/src/keymap.c

[Kim F. Storm]

Index: emacs/src/keymap.c
diff -c emacs/src/keymap.c:1.256 emacs/src/keymap.c:1.257
*** emacs/src/keymap.c:1.256    Thu Feb  7 06:12:50 2002
--- emacs/src/keymap.c  Sat Feb 23 17:00:37 2002
***************
*** 89,99 ****
     when Emacs starts up.   t means don't record anything here.  */
  Lisp_Object Vdefine_key_rebound_commands;
  
! Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
  
  /* Alist of elements like (DEL . "\d").  */
  static Lisp_Object exclude_keys;
  
  /* A char with the CHAR_META bit set in a vector or the 0200 bit set
     in a string key sequence is equivalent to prefixing with this
     character.  */
--- 89,102 ----
     when Emacs starts up.   t means don't record anything here.  */
  Lisp_Object Vdefine_key_rebound_commands;
  
! Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
  
  /* Alist of elements like (DEL . "\d").  */
  static Lisp_Object exclude_keys;
  
+ /* Pre-allocated 2-element vector for Fremap_command to use.  */
+ static Lisp_Object remap_command_vector;
+ 
  /* A char with the CHAR_META bit set in a vector or the 0200 bit set
     in a string key sequence is equivalent to prefixing with this
     character.  */
***************
*** 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;
--- 976,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.  */)
       (keymap, key, def)
       Lisp_Object keymap;
       Lisp_Object key;
***************
*** 992,1020 ****
  
    keymap = get_keymap (keymap, 1, 1);
  
!   if (SYMBOLP (key))
!     {
!       /* A command may only be remapped to another command.  */
! 
!       /* I thought of using 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, e.g. if a minor
!        mode were to remap a command of another minor mode which has
!        not yet been loaded, it would fail.  So just 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)
      return Qnil;
  
    if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
      Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
  
--- 992,1009 ----
  
    keymap = get_keymap (keymap, 1, 1);
  
!   if (!VECTORP (key) && !STRINGP (key))
        key = wrong_type_argument (Qarrayp, key);
  
    length = XFASTINT (Flength (key));
    if (length == 0)
      return Qnil;
  
+   /* Check for valid [remap COMMAND] bindings.  */
+   if (VECTORP (key) && EQ (AREF (key, 0), Qremap)
+       && (length != 2 || !SYMBOLP (AREF (key, 1))))
+     wrong_type_argument (Qvectorp, key);
+ 
    if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
      Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
  
***************
*** 1073,1078 ****
--- 1062,1080 ----
      }
  }
  
+ /* This function may GC (it calls Fkey_binding).  */
+ 
+ DEFUN ("remap-command", Fremap_command, Sremap_command, 1, 1, 0,
+        doc: /* Return the remapping for command COMMAND in current keymaps.
+ Returns nil if COMMAND is not remapped.  */)
+      (command)
+      Lisp_Object command;
+ {
+   /* This will GCPRO the command argument.  */
+   ASET (remap_command_vector, 1, command);
+   return Fkey_binding (remap_command_vector, Qnil, Qt);
+ }
+ 
  /* Value is number if KEY is too long; nil if valid but has no definition. */
  /* GC is possible in this function if it autoloads a keymap.  */
  
***************
*** 1105,1113 ****
  
    keymap = get_keymap (keymap, 1, 1);
  
!   /* Command remapping is simple.  */
!   if (SYMBOLP (key))
!     return access_keymap (keymap, key, t_ok, 0, 1);
  
    if (!VECTORP (key) && !STRINGP (key))
      key = wrong_type_argument (Qarrayp, key);
--- 1107,1125 ----
  
    keymap = get_keymap (keymap, 1, 1);
  
!   /* Perform command remapping initiated by Fremap_command directly.
!      This is strictly not necessary, but it is faster and it returns
!      nil instead of 1 if KEYMAP doesn't contain command remappings.  */
!   if (EQ (key, remap_command_vector))
!     {
!       /* KEY has format [remap COMMAND]. 
!        Lookup `remap' in KEYMAP; result is nil or a keymap containing
!        command remappings.  Then lookup COMMAND in that keymap.  */
!       if ((keymap = access_keymap (keymap, Qremap, t_ok, 0, 1), !NILP 
(keymap))
!         && (keymap = get_keymap (keymap, 0, 1), CONSP (keymap)))
!       return access_keymap (keymap, AREF (key, 1), t_ok, 0, 1);
!       return Qnil;
!     }
  
    if (!VECTORP (key) && !STRINGP (key))
      key = wrong_type_argument (Qarrayp, key);
***************
*** 1386,1426 ****
    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,
--- 1398,1403 ----
***************
*** 1503,1514 ****
    /* 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;
      }
    
--- 1480,1489 ----
    /* 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) && SYMBOLP (value))
      {
        Lisp_Object value1;
!       if (value1 = Fremap_command (value), !NILP (value1))
        value = value1;
      }
    
***************
*** 2272,2280 ****
  
    /* If this command is remapped, then it has no key bindings
       of its own.  */
!   if (NILP (no_remap) && is_command_symbol (definition)
!       && !NILP (Fkey_binding (definition, Qnil, Qt)))
!     return Qnil;
  
    found = keymaps;
    while (CONSP (found))
--- 2247,2258 ----
  
    /* If this command is remapped, then it has no key bindings
       of its own.  */
!   if (NILP (no_remap) && SYMBOLP (definition))
!     {
!       Lisp_Object tem;
!       if (tem = Fremap_command (definition), !NILP (tem))
!       return Qnil;
!     }
  
    found = keymaps;
    while (CONSP (found))
***************
*** 2383,2419 ****
  
          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;
!                       }
                    }
                }
  
--- 2361,2392 ----
  
          while (!NILP (sequences))
            {
!             Lisp_Object sequence, remapped, function;
  
              sequence = XCAR (sequences);
              sequences = XCDR (sequences);
  
!             /* If the current sequence is a command remapping with
!                format [remap COMMAND], find the key sequences
!                which run COMMAND, and use those sequences instead.  */
              remapped = Qnil;
              if (NILP (no_remap)
!                 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
!                 && EQ (AREF (sequence, 0), Qremap)
!                 && (function = AREF (sequence, 1), SYMBOLP (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;
                    }
                }
  
***************
*** 3646,3651 ****
--- 3619,3630 ----
    Qmenu_item = intern ("menu-item");
    staticpro (&Qmenu_item);
  
+   Qremap = intern ("remap");
+   staticpro (&Qremap);
+ 
+   remap_command_vector = Fmake_vector (make_number (2), Qremap);
+   staticpro (&remap_command_vector);
+ 
    where_is_cache_keymaps = Qt;
    where_is_cache = Qnil;
    staticpro (&where_is_cache);
***************
*** 3658,3663 ****
--- 3637,3643 ----
    defsubr (&Smake_keymap);
    defsubr (&Smake_sparse_keymap);
    defsubr (&Scopy_keymap);
+   defsubr (&Sremap_command);
    defsubr (&Skey_binding);
    defsubr (&Slocal_key_binding);
    defsubr (&Sglobal_key_binding);