/[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.254 by rms, Thu Jan 3 21:28:04 2002 UTC revision 1.255 by kfstorm, Wed Feb 6 22:57:42 2002 UTC
# Line 954  is not copied.  */) Line 954  is not copied.  */)
954    
955  DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,  DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
956         doc: /* Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.         doc: /* Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.
957  KEYMAP is a keymap.  KEY is a string or a vector of symbols and characters  KEYMAP is a keymap.
958  meaning a sequence of keystrokes and events.  
959  Non-ASCII characters with codes above 127 (such as ISO Latin-1)  KEY is a string or a vector of symbols and characters meaning a
960  can be included if you use a vector.  sequence of keystrokes and events.  Non-ASCII characters with codes
961    above 127 (such as ISO Latin-1) can be included if you use a vector.
962    
963  DEF is anything that can be a key's definition:  DEF is anything that can be a key's definition:
964   nil (means key is undefined in this keymap),   nil (means key is undefined in this keymap),
965   a command (a Lisp function suitable for interactive calling)   a command (a Lisp function suitable for interactive calling)
# Line 971  DEF is anything that can be a key's defi Line 973  DEF is anything that can be a key's defi
973   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.
974    
975  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
976  the front of KEYMAP.  */)  the front of KEYMAP.  
977    
978    KEY may also be a command name which is remapped to DEF.  In this case,
979    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 987  the front of KEYMAP.  */) Line 992  the front of KEYMAP.  */)
992    
993    keymap = get_keymap (keymap, 1, 1);    keymap = get_keymap (keymap, 1, 1);
994    
995    if (!VECTORP (key) && !STRINGP (key))    if (SYMBOLP (key))
996      key = wrong_type_argument (Qarrayp, key);      {
997          /* A command may only be remapped to another command.  */
998    
999          /* I thought of using is_command_symbol above and below instead
1000             of SYMBOLP, since remapping only works for sych symbols.
1001             However, to make that a requirement would make it impossible
1002             to remap a command before it has been defined, e.g. if a minor
1003             mode were to remap a command of another minor mode which has
1004             not yet been loaded, it would fail.  So just use the least
1005             restrictive sanity check here.  */
1006          if (!SYMBOLP (def))
1007            key = wrong_type_argument (Qsymbolp, def);
1008          else
1009            key = Fmake_vector (make_number (1), key);
1010        }
1011      else if (!VECTORP (key) && !STRINGP (key))
1012          key = wrong_type_argument (Qarrayp, key);
1013    
1014    length = XFASTINT (Flength (key));    length = XFASTINT (Flength (key));
1015    if (length == 0)    if (length == 0)
# Line 1084  recognize the default bindings, just as Line 1105  recognize the default bindings, just as
1105    
1106    keymap = get_keymap (keymap, 1, 1);    keymap = get_keymap (keymap, 1, 1);
1107    
1108      /* Command remapping is simple.  */
1109      if (SYMBOLP (key))
1110        return access_keymap (keymap, key, t_ok, 0, 1);
1111    
1112    if (!VECTORP (key) && !STRINGP (key))    if (!VECTORP (key) && !STRINGP (key))
1113      key = wrong_type_argument (Qarrayp, key);      key = wrong_type_argument (Qarrayp, key);
1114    
# Line 1361  OLP if non-nil indicates that we should Line 1386  OLP if non-nil indicates that we should
1386    return keymaps;    return keymaps;
1387  }  }
1388    
1389    /* Like Fcommandp, but looks specifically for a command symbol, and
1390       doesn't signal errors.  Returns 1 if FUNCTION is a command symbol.  */
1391    int
1392    is_command_symbol (function)
1393         Lisp_Object function;
1394    {
1395      if (!SYMBOLP (function) || EQ (function, Qunbound))
1396        return 0;
1397    
1398      function = indirect_function (function);
1399      if (SYMBOLP (function) && EQ (function, Qunbound))
1400        return 0;
1401    
1402      if (SUBRP (function))
1403        return (XSUBR (function)->prompt != 0);
1404    
1405      if (COMPILEDP (function))
1406        return ((ASIZE (function) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE);
1407      
1408      if (CONSP (function))
1409        {
1410          Lisp_Object funcar;
1411    
1412          funcar = Fcar (function);
1413          if (SYMBOLP (funcar))
1414            {
1415              if (EQ (funcar, Qlambda))
1416                return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (function))));
1417              if (EQ (funcar, Qautoload))
1418                return !NILP (Fcar (Fcdr (Fcdr (Fcdr (function)))));
1419            }
1420        }
1421      return 0;
1422    }
1423    
1424  /* GC is possible in this function if it autoloads a keymap.  */  /* GC is possible in this function if it autoloads a keymap.  */
1425    
1426  DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,  DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0,
1427         doc: /* Return the binding for command KEY in current keymaps.         doc: /* Return the binding for command KEY in current keymaps.
1428  KEY is a string or vector, a sequence of keystrokes.  KEY is a string or vector, a sequence of keystrokes.
1429  The binding is probably a symbol with a function definition.  The binding is probably a symbol with a function definition.
# Line 1372  Normally, `key-binding' ignores bindings Line 1432  Normally, `key-binding' ignores bindings
1432  bindings, used when nothing else in the keymap applies; this makes it  bindings, used when nothing else in the keymap applies; this makes it
1433  usable as a general function for probing keymaps.  However, if the  usable as a general function for probing keymaps.  However, if the
1434  optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does  optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1435  recognize the default bindings, just as `read-key-sequence' does.  */)  recognize the default bindings, just as `read-key-sequence' does.
1436       (key, accept_default)  
1437       Lisp_Object key, accept_default;  Like the normal command loop, `key-binding' will remap the command
1438    resulting from looking up KEY by looking up the command in the
1439    currrent keymaps.  However, if the optional third argument NO-REMAP
1440    is non-nil, `key-binding' returns the unmapped command.  */)
1441         (key, accept_default, no_remap)
1442         Lisp_Object key, accept_default, no_remap;
1443  {  {
1444    Lisp_Object *maps, value;    Lisp_Object *maps, value;
1445    int nmaps, i;    int nmaps, i;
# Line 1387  recognize the default bindings, just as Line 1452  recognize the default bindings, just as
1452        value = Flookup_key (current_kboard->Voverriding_terminal_local_map,        value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1453                             key, accept_default);                             key, accept_default);
1454        if (! NILP (value) && !INTEGERP (value))        if (! NILP (value) && !INTEGERP (value))
1455          RETURN_UNGCPRO (value);          goto done;
1456      }      }
1457    else if (!NILP (Voverriding_local_map))    else if (!NILP (Voverriding_local_map))
1458      {      {
1459        value = Flookup_key (Voverriding_local_map, key, accept_default);        value = Flookup_key (Voverriding_local_map, key, accept_default);
1460        if (! NILP (value) && !INTEGERP (value))        if (! NILP (value) && !INTEGERP (value))
1461          RETURN_UNGCPRO (value);          goto done;
1462      }      }
1463    else    else
1464      {      {
# Line 1404  recognize the default bindings, just as Line 1469  recognize the default bindings, just as
1469          {          {
1470            value = Flookup_key (local, key, accept_default);            value = Flookup_key (local, key, accept_default);
1471            if (! NILP (value) && !INTEGERP (value))            if (! NILP (value) && !INTEGERP (value))
1472              RETURN_UNGCPRO (value);              goto done;
1473          }          }
1474    
1475        nmaps = current_minor_maps (0, &maps);        nmaps = current_minor_maps (0, &maps);
# Line 1416  recognize the default bindings, just as Line 1481  recognize the default bindings, just as
1481            {            {
1482              value = Flookup_key (maps[i], key, accept_default);              value = Flookup_key (maps[i], key, accept_default);
1483              if (! NILP (value) && !INTEGERP (value))              if (! NILP (value) && !INTEGERP (value))
1484                RETURN_UNGCPRO (value);                goto done;
1485            }            }
1486    
1487        local = get_local_map (PT, current_buffer, Qlocal_map);        local = get_local_map (PT, current_buffer, Qlocal_map);
# Line 1424  recognize the default bindings, just as Line 1489  recognize the default bindings, just as
1489          {          {
1490            value = Flookup_key (local, key, accept_default);            value = Flookup_key (local, key, accept_default);
1491            if (! NILP (value) && !INTEGERP (value))            if (! NILP (value) && !INTEGERP (value))
1492              RETURN_UNGCPRO (value);              goto done;
1493          }          }
1494      }      }
1495    
1496    value = Flookup_key (current_global_map, key, accept_default);    value = Flookup_key (current_global_map, key, accept_default);
1497    
1498     done:
1499    UNGCPRO;    UNGCPRO;
1500    if (! NILP (value) && !INTEGERP (value))    if (NILP (value) || INTEGERP (value))
1501      return value;      return Qnil;
1502    
1503      /* If the result of the ordinary keymap lookup is an interactive
1504         command, look for a key binding (ie. remapping) for that command.  */
1505        
1506      if (NILP (no_remap) && is_command_symbol (value))
1507        {
1508          Lisp_Object value1;
1509    
1510          value1 = Fkey_binding (value, accept_default, Qt);
1511          if (!NILP (value1) && is_command_symbol (value1))
1512            value = value1;
1513        }
1514        
1515    return Qnil;    return value;
1516  }  }
1517    
1518  /* GC is possible in this function if it autoloads a keymap.  */  /* GC is possible in this function if it autoloads a keymap.  */
# Line 2156  ascii_sequence_p (seq) Line 2235  ascii_sequence_p (seq)
2235    
2236  /* where-is - finding a command in a set of keymaps.                    */  /* where-is - finding a command in a set of keymaps.                    */
2237    
2238    static Lisp_Object where_is_internal ();
2239  static Lisp_Object where_is_internal_1 ();  static Lisp_Object where_is_internal_1 ();
2240  static void where_is_internal_2 ();  static void where_is_internal_2 ();
2241    
# Line 2180  shadow_lookup (shadow, key, flag) Line 2260  shadow_lookup (shadow, key, flag)
2260  /* This function can GC if Flookup_key autoloads any keymaps.  */  /* This function can GC if Flookup_key autoloads any keymaps.  */
2261    
2262  static Lisp_Object  static Lisp_Object
2263  where_is_internal (definition, keymaps, firstonly, noindirect)  where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2264       Lisp_Object definition, keymaps;       Lisp_Object definition, keymaps;
2265       Lisp_Object firstonly, noindirect;       Lisp_Object firstonly, noindirect, no_remap;
2266  {  {
2267    Lisp_Object maps = Qnil;    Lisp_Object maps = Qnil;
2268    Lisp_Object found, sequences;    Lisp_Object found, sequences;
# Line 2190  where_is_internal (definition, keymaps, Line 2270  where_is_internal (definition, keymaps,
2270    /* 1 means ignore all menu bindings entirely.  */    /* 1 means ignore all menu bindings entirely.  */
2271    int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);    int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2272    
2273      /* If this command is remapped, then it has no key bindings
2274         of its own.  */
2275      if (NILP (no_remap)
2276          && !NILP (Fkey_binding (definition, Qnil, Qt)))
2277        return Qnil;
2278    
2279    found = keymaps;    found = keymaps;
2280    while (CONSP (found))    while (CONSP (found))
2281      {      {
# Line 2295  where_is_internal (definition, keymaps, Line 2381  where_is_internal (definition, keymaps,
2381              }              }
2382    
2383    
2384            for (; !NILP (sequences); sequences = XCDR (sequences))            while (!NILP (sequences))
2385              {              {
2386                Lisp_Object sequence;                Lisp_Object sequence;
2387                  Lisp_Object remapped;
2388    
2389                sequence = XCAR (sequences);                sequence = XCAR (sequences);
2390                  sequences = XCDR (sequences);
2391    
2392                  /* If the current sequence is of the form [command],
2393                     this may be a remapped command, so look for the key
2394                     sequences which run that command, and return those
2395                     sequences instead.  */
2396                  remapped = Qnil;
2397                  if (NILP (no_remap)
2398                      && VECTORP (sequence) && XVECTOR (sequence)->size == 1)
2399                    {
2400                      Lisp_Object function;
2401    
2402                      function = AREF (sequence, 0);
2403                      if (is_command_symbol (function))
2404                        {
2405                          Lisp_Object remapped1;
2406                          remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2407                          if (CONSP (remapped1))
2408                            {
2409                              /* Verify that this key binding actually maps to the
2410                                 remapped command (see below).  */
2411                              if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2412                                continue;
2413                              sequence = XCAR (remapped1);
2414                              remapped = XCDR (remapped1);
2415                              goto record_sequence;
2416                            }
2417                        }
2418                    }
2419    
2420                /* Verify that this key binding is not shadowed by another                /* Verify that this key binding is not shadowed by another
2421                   binding for the same key, before we say it exists.                   binding for the same key, before we say it exists.
# Line 2313  where_is_internal (definition, keymaps, Line 2429  where_is_internal (definition, keymaps,
2429                if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))                if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2430                  continue;                  continue;
2431    
2432                record_sequence:
2433                /* It is a true unshadowed match.  Record it, unless it's already                /* It is a true unshadowed match.  Record it, unless it's already
2434                   been seen (as could happen when inheriting keymaps).  */                   been seen (as could happen when inheriting keymaps).  */
2435                if (NILP (Fmember (sequence, found)))                if (NILP (Fmember (sequence, found)))
# Line 2326  where_is_internal (definition, keymaps, Line 2443  where_is_internal (definition, keymaps,
2443                  RETURN_UNGCPRO (sequence);                  RETURN_UNGCPRO (sequence);
2444                else if (!NILP (firstonly) && ascii_sequence_p (sequence))                else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2445                  RETURN_UNGCPRO (sequence);                  RETURN_UNGCPRO (sequence);
2446    
2447                  if (CONSP (remapped))
2448                    {
2449                      sequence = XCAR (remapped);
2450                      remapped = XCDR (remapped);
2451                      goto record_sequence;
2452                    }
2453              }              }
2454          }          }
2455      }      }
# Line 2343  where_is_internal (definition, keymaps, Line 2467  where_is_internal (definition, keymaps,
2467    return found;    return found;
2468  }  }
2469    
2470  DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,  DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2471         doc: /* Return list of keys that invoke DEFINITION.         doc: /* Return list of keys that invoke DEFINITION.
2472  If KEYMAP is non-nil, search only KEYMAP and the global keymap.  If KEYMAP is non-nil, search only KEYMAP and the global keymap.
2473  If KEYMAP is nil, search all the currently active keymaps.  If KEYMAP is nil, search all the currently active keymaps.
# Line 2358  and entirely reject menu bindings. Line 2482  and entirely reject menu bindings.
2482    
2483  If optional 4th arg NOINDIRECT is non-nil, don't follow indirections  If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2484  to other keymaps or slots.  This makes it possible to search for an  to other keymaps or slots.  This makes it possible to search for an
2485  indirect definition itself.  */)  indirect definition itself.
2486       (definition, keymap, firstonly, noindirect)  
2487    If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2488    that invoke a command which is remapped to DEFINITION, but include the
2489    remapped command in the returned list.  */)
2490         (definition, keymap, firstonly, noindirect, no_remap)
2491       Lisp_Object definition, keymap;       Lisp_Object definition, keymap;
2492       Lisp_Object firstonly, noindirect;       Lisp_Object firstonly, noindirect, no_remap;
2493  {  {
2494    Lisp_Object sequences, keymaps;    Lisp_Object sequences, keymaps;
2495    /* 1 means ignore all menu bindings entirely.  */    /* 1 means ignore all menu bindings entirely.  */
# Line 2382  indirect definition itself.  */) Line 2510  indirect definition itself.  */)
2510      {      {
2511        Lisp_Object *defns;        Lisp_Object *defns;
2512        int i, j, n;        int i, j, n;
2513        struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;        struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2514                
2515        /* Check heuristic-consistency of the cache.  */        /* Check heuristic-consistency of the cache.  */
2516        if (NILP (Fequal (keymaps, where_is_cache_keymaps)))        if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
# Line 2396  indirect definition itself.  */) Line 2524  indirect definition itself.  */)
2524            where_is_cache_keymaps = Qt;            where_is_cache_keymaps = Qt;
2525                        
2526            /* Fill in the cache.  */            /* Fill in the cache.  */
2527            GCPRO4 (definition, keymaps, firstonly, noindirect);            GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2528            where_is_internal (definition, keymaps, firstonly, noindirect);            where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2529            UNGCPRO;            UNGCPRO;
2530    
2531            where_is_cache_keymaps = keymaps;            where_is_cache_keymaps = keymaps;
# Line 2434  indirect definition itself.  */) Line 2562  indirect definition itself.  */)
2562        /* Kill the cache so that where_is_internal_1 doesn't think        /* Kill the cache so that where_is_internal_1 doesn't think
2563           we're filling it up.  */           we're filling it up.  */
2564        where_is_cache = Qnil;        where_is_cache = Qnil;
2565        result = where_is_internal (definition, keymaps, firstonly, noindirect);        result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2566      }      }
2567    
2568    return result;    return result;

Legend:
Removed from v.1.254  
changed lines
  Added in v.1.255

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