/[emacs]/emacs/src/keymap.c
ViewVC logotype

Diff of /emacs/src/keymap.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.256 by kfstorm, Thu Feb 7 11:12:50 2002 UTC revision 1.257 by kfstorm, Sat Feb 23 22:00:37 2002 UTC
# Line 89  Lisp_Object Vkey_translation_map; Line 89  Lisp_Object Vkey_translation_map;
89     when Emacs starts up.   t means don't record anything here.  */     when Emacs starts up.   t means don't record anything here.  */
90  Lisp_Object Vdefine_key_rebound_commands;  Lisp_Object Vdefine_key_rebound_commands;
91    
92  Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;  Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
93    
94  /* Alist of elements like (DEL . "\d").  */  /* Alist of elements like (DEL . "\d").  */
95  static Lisp_Object exclude_keys;  static Lisp_Object exclude_keys;
96    
97    /* Pre-allocated 2-element vector for Fremap_command to use.  */
98    static Lisp_Object remap_command_vector;
99    
100  /* A char with the CHAR_META bit set in a vector or the 0200 bit set  /* A char with the CHAR_META bit set in a vector or the 0200 bit set
101     in a string key sequence is equivalent to prefixing with this     in a string key sequence is equivalent to prefixing with this
102     character.  */     character.  */
# Line 973  DEF is anything that can be a key's defi Line 976  DEF is anything that can be a key's defi
976   or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.   or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
977    
978  If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at  If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at
979  the front of KEYMAP.    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).  */)  
980       (keymap, key, def)       (keymap, key, def)
981       Lisp_Object keymap;       Lisp_Object keymap;
982       Lisp_Object key;       Lisp_Object key;
# Line 992  DEF must be a symbol or nil (to remove a Line 992  DEF must be a symbol or nil (to remove a
992    
993    keymap = get_keymap (keymap, 1, 1);    keymap = get_keymap (keymap, 1, 1);
994    
995    if (SYMBOLP (key))    if (!VECTORP (key) && !STRINGP (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))  
996        key = wrong_type_argument (Qarrayp, key);        key = wrong_type_argument (Qarrayp, key);
997    
998    length = XFASTINT (Flength (key));    length = XFASTINT (Flength (key));
999    if (length == 0)    if (length == 0)
1000      return Qnil;      return Qnil;
1001    
1002      /* Check for valid [remap COMMAND] bindings.  */
1003      if (VECTORP (key) && EQ (AREF (key, 0), Qremap)
1004          && (length != 2 || !SYMBOLP (AREF (key, 1))))
1005        wrong_type_argument (Qvectorp, key);
1006    
1007    if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))    if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1008      Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);      Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1009    
# Line 1073  DEF must be a symbol or nil (to remove a Line 1062  DEF must be a symbol or nil (to remove a
1062      }      }
1063  }  }
1064    
1065    /* This function may GC (it calls Fkey_binding).  */
1066    
1067    DEFUN ("remap-command", Fremap_command, Sremap_command, 1, 1, 0,
1068           doc: /* Return the remapping for command COMMAND in current keymaps.
1069    Returns nil if COMMAND is not remapped.  */)
1070         (command)
1071         Lisp_Object command;
1072    {
1073      /* This will GCPRO the command argument.  */
1074      ASET (remap_command_vector, 1, command);
1075      return Fkey_binding (remap_command_vector, Qnil, Qt);
1076    }
1077    
1078  /* Value is number if KEY is too long; nil if valid but has no definition. */  /* Value is number if KEY is too long; nil if valid but has no definition. */
1079  /* GC is possible in this function if it autoloads a keymap.  */  /* GC is possible in this function if it autoloads a keymap.  */
1080    
# Line 1105  recognize the default bindings, just as Line 1107  recognize the default bindings, just as
1107    
1108    keymap = get_keymap (keymap, 1, 1);    keymap = get_keymap (keymap, 1, 1);
1109    
1110    /* Command remapping is simple.  */    /* Perform command remapping initiated by Fremap_command directly.
1111    if (SYMBOLP (key))       This is strictly not necessary, but it is faster and it returns
1112      return access_keymap (keymap, key, t_ok, 0, 1);       nil instead of 1 if KEYMAP doesn't contain command remappings.  */
1113      if (EQ (key, remap_command_vector))
1114        {
1115          /* KEY has format [remap COMMAND].
1116             Lookup `remap' in KEYMAP; result is nil or a keymap containing
1117             command remappings.  Then lookup COMMAND in that keymap.  */
1118          if ((keymap = access_keymap (keymap, Qremap, t_ok, 0, 1), !NILP (keymap))
1119              && (keymap = get_keymap (keymap, 0, 1), CONSP (keymap)))
1120            return access_keymap (keymap, AREF (key, 1), t_ok, 0, 1);
1121          return Qnil;
1122        }
1123    
1124    if (!VECTORP (key) && !STRINGP (key))    if (!VECTORP (key) && !STRINGP (key))
1125      key = wrong_type_argument (Qarrayp, key);      key = wrong_type_argument (Qarrayp, key);
# Line 1386  OLP if non-nil indicates that we should Line 1398  OLP if non-nil indicates that we should
1398    return keymaps;    return keymaps;
1399  }  }
1400    
 /* 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;  
 }  
   
1401  /* GC is possible in this function if it autoloads a keymap.  */  /* GC is possible in this function if it autoloads a keymap.  */
1402    
1403  DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0,  DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0,
# Line 1503  is non-nil, `key-binding' returns the un Line 1480  is non-nil, `key-binding' returns the un
1480    /* If the result of the ordinary keymap lookup is an interactive    /* If the result of the ordinary keymap lookup is an interactive
1481       command, look for a key binding (ie. remapping) for that command.  */       command, look for a key binding (ie. remapping) for that command.  */
1482            
1483    if (NILP (no_remap) && is_command_symbol (value))    if (NILP (no_remap) && SYMBOLP (value))
1484      {      {
1485        Lisp_Object value1;        Lisp_Object value1;
1486          if (value1 = Fremap_command (value), !NILP (value1))
       value1 = Fkey_binding (value, accept_default, Qt);  
       if (!NILP (value1) && is_command_symbol (value1))  
1487          value = value1;          value = value1;
1488      }      }
1489        
# Line 2272  where_is_internal (definition, keymaps, Line 2247  where_is_internal (definition, keymaps,
2247    
2248    /* If this command is remapped, then it has no key bindings    /* If this command is remapped, then it has no key bindings
2249       of its own.  */       of its own.  */
2250    if (NILP (no_remap) && is_command_symbol (definition)    if (NILP (no_remap) && SYMBOLP (definition))
2251        && !NILP (Fkey_binding (definition, Qnil, Qt)))      {
2252      return Qnil;        Lisp_Object tem;
2253          if (tem = Fremap_command (definition), !NILP (tem))
2254            return Qnil;
2255        }
2256    
2257    found = keymaps;    found = keymaps;
2258    while (CONSP (found))    while (CONSP (found))
# Line 2383  where_is_internal (definition, keymaps, Line 2361  where_is_internal (definition, keymaps,
2361    
2362            while (!NILP (sequences))            while (!NILP (sequences))
2363              {              {
2364                Lisp_Object sequence;                Lisp_Object sequence, remapped, function;
               Lisp_Object remapped;  
2365    
2366                sequence = XCAR (sequences);                sequence = XCAR (sequences);
2367                sequences = XCDR (sequences);                sequences = XCDR (sequences);
2368    
2369                /* If the current sequence is of the form [command],                /* If the current sequence is a command remapping with
2370                   this may be a remapped command, so look for the key                   format [remap COMMAND], find the key sequences
2371                   sequences which run that command, and return those                   which run COMMAND, and use those sequences instead.  */
                  sequences instead.  */  
2372                remapped = Qnil;                remapped = Qnil;
2373                if (NILP (no_remap)                if (NILP (no_remap)
2374                    && VECTORP (sequence) && XVECTOR (sequence)->size == 1)                    && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2375                      && EQ (AREF (sequence, 0), Qremap)
2376                      && (function = AREF (sequence, 1), SYMBOLP (function)))
2377                  {                  {
2378                    Lisp_Object function;                    Lisp_Object remapped1;
2379    
2380                    function = AREF (sequence, 0);                    remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2381                    if (is_command_symbol (function))                    if (CONSP (remapped1))
2382                      {                      {
2383                        Lisp_Object remapped1;                        /* Verify that this key binding actually maps to the
2384                        remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);                           remapped command (see below).  */
2385                        if (CONSP (remapped1))                        if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2386                          {                          continue;
2387                            /* Verify that this key binding actually maps to the                        sequence = XCAR (remapped1);
2388                               remapped command (see below).  */                        remapped = XCDR (remapped1);
2389                            if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))                        goto record_sequence;
                             continue;  
                           sequence = XCAR (remapped1);  
                           remapped = XCDR (remapped1);  
                           goto record_sequence;  
                         }  
2390                      }                      }
2391                  }                  }
2392    
# Line 3646  and applies even for keys that have ordi Line 3619  and applies even for keys that have ordi
3619    Qmenu_item = intern ("menu-item");    Qmenu_item = intern ("menu-item");
3620    staticpro (&Qmenu_item);    staticpro (&Qmenu_item);
3621    
3622      Qremap = intern ("remap");
3623      staticpro (&Qremap);
3624    
3625      remap_command_vector = Fmake_vector (make_number (2), Qremap);
3626      staticpro (&remap_command_vector);
3627    
3628    where_is_cache_keymaps = Qt;    where_is_cache_keymaps = Qt;
3629    where_is_cache = Qnil;    where_is_cache = Qnil;
3630    staticpro (&where_is_cache);    staticpro (&where_is_cache);
# Line 3658  and applies even for keys that have ordi Line 3637  and applies even for keys that have ordi
3637    defsubr (&Smake_keymap);    defsubr (&Smake_keymap);
3638    defsubr (&Smake_sparse_keymap);    defsubr (&Smake_sparse_keymap);
3639    defsubr (&Scopy_keymap);    defsubr (&Scopy_keymap);
3640      defsubr (&Sremap_command);
3641    defsubr (&Skey_binding);    defsubr (&Skey_binding);
3642    defsubr (&Slocal_key_binding);    defsubr (&Slocal_key_binding);
3643    defsubr (&Sglobal_key_binding);    defsubr (&Sglobal_key_binding);

Legend:
Removed from v.1.256  
changed lines
  Added in v.1.257

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26