src/keymap.c

   1 /* Manipulation of keymaps
   2    Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
   3                  1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4                  2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 This file is part of GNU Emacs.
   7
   8 GNU Emacs is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Emacs is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Emacs; see the file COPYING.  If not, write to
  20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21 Boston, MA 02110-1301, USA.  */
  22
  23
  24 #include <config.h>
  25 #include <stdio.h>
  26 #if HAVE_ALLOCA_H
  27 # include <alloca.h>
  28 #endif
  29 #include "lisp.h"
  30 #include "commands.h"
  31 #include "buffer.h"
  32 #include "charset.h"
  33 #include "keyboard.h"
  34 #include "termhooks.h"
  35 #include "blockinput.h"
  36 #include "puresize.h"
  37 #include "intervals.h"
  38 #include "keymap.h"
  39 #include "window.h"
  40
  41 /* The number of elements in keymap vectors.  */
  42 #define DENSE_TABLE_SIZE (0200)
  43
  44 /* Actually allocate storage for these variables */
  45
  46 Lisp_Object current_global_map; /* Current global keymap */
  47
  48 Lisp_Object global_map;         /* default global key bindings */
  49
  50 Lisp_Object meta_map;           /* The keymap used for globally bound
  51                                    ESC-prefixed default commands */
  52
  53 Lisp_Object control_x_map;      /* The keymap used for globally bound
  54                                    C-x-prefixed default commands */
  55
  56 /* was MinibufLocalMap */
  57 Lisp_Object Vminibuffer_local_map;
  58                                 /* The keymap used by the minibuf for local
  59                                    bindings when spaces are allowed in the
  60                                    minibuf */
  61
  62 /* was MinibufLocalNSMap */
  63 Lisp_Object Vminibuffer_local_ns_map;
  64                                 /* The keymap used by the minibuf for local
  65                                    bindings when spaces are not encouraged
  66                                    in the minibuf */
  67
  68 /* keymap used for minibuffers when doing completion */
  69 /* was MinibufLocalCompletionMap */
  70 Lisp_Object Vminibuffer_local_completion_map;
  71
  72 /* keymap used for minibuffers when doing completion in filenames */
  73 Lisp_Object Vminibuffer_local_filename_completion_map;
  74
  75 /* keymap used for minibuffers when doing completion in filenames
  76    with require-match*/
  77 Lisp_Object Vminibuffer_local_must_match_filename_map;
  78
  79 /* keymap used for minibuffers when doing completion and require a match */
  80 /* was MinibufLocalMustMatchMap */
  81 Lisp_Object Vminibuffer_local_must_match_map;
  82
  83 /* Alist of minor mode variables and keymaps.  */
  84 Lisp_Object Vminor_mode_map_alist;
  85
  86 /* Alist of major-mode-specific overrides for
  87    minor mode variables and keymaps.  */
  88 Lisp_Object Vminor_mode_overriding_map_alist;
  89
  90 /* List of emulation mode keymap alists.  */
  91 Lisp_Object Vemulation_mode_map_alists;
  92
  93 /* Keymap mapping ASCII function key sequences onto their preferred forms.
  94    Initialized by the terminal-specific lisp files.  See DEFVAR for more
  95    documentation.  */
  96 Lisp_Object Vfunction_key_map;
  97
  98 /* Keymap mapping ASCII function key sequences onto their preferred forms.  */
  99 Lisp_Object Vkey_translation_map;
 100
 101 /* A list of all commands given new bindings since a certain time
 102    when nil was stored here.
 103    This is used to speed up recomputation of menu key equivalents
 104    when Emacs starts up.   t means don't record anything here.  */
 105 Lisp_Object Vdefine_key_rebound_commands;
 106
 107 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
 108
 109 /* Alist of elements like (DEL . "\d").  */
 110 static Lisp_Object exclude_keys;
 111
 112 /* Pre-allocated 2-element vector for Fcommand_remapping to use.  */
 113 static Lisp_Object command_remapping_vector;
 114
 115 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
 116    in a string key sequence is equivalent to prefixing with this
 117    character.  */
 118 extern Lisp_Object meta_prefix_char;
 119
 120 extern Lisp_Object Voverriding_local_map;
 121
 122 /* Hash table used to cache a reverse-map to speed up calls to where-is.  */
 123 static Lisp_Object where_is_cache;
 124 /* Which keymaps are reverse-stored in the cache.  */
 125 static Lisp_Object where_is_cache_keymaps;
 126
 127 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 128 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 129
 130 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
 131 static void describe_command P_ ((Lisp_Object, Lisp_Object));
 132 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
 133 static void describe_map P_ ((Lisp_Object, Lisp_Object,
 134                               void (*) P_ ((Lisp_Object, Lisp_Object)),
 135                               int, Lisp_Object, Lisp_Object*, int, int));
 136 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
 137                                  void (*) (Lisp_Object, Lisp_Object), int,
 138                                  Lisp_Object, Lisp_Object, int *,
 139                                  int, int, int));
 140 static void silly_event_symbol_error P_ ((Lisp_Object));
 141 \f
 142 /* Keymap object support - constructors and predicates.                 */
 143
 144 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
 145        doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
 146 CHARTABLE is a char-table that holds the bindings for all characters
 147 without modifiers.  All entries in it are initially nil, meaning
 148 "command undefined".  ALIST is an assoc-list which holds bindings for
 149 function keys, mouse events, and any other things that appear in the
 150 input stream.  Initially, ALIST is nil.
 151
 152 The optional arg STRING supplies a menu name for the keymap
 153 in case you use it as a menu with `x-popup-menu'.  */)
 154      (string)
 155      Lisp_Object string;
 156 {
 157   Lisp_Object tail;
 158   if (!NILP (string))
 159     tail = Fcons (string, Qnil);
 160   else
 161     tail = Qnil;
 162   return Fcons (Qkeymap,
 163                 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
 164 }
 165
 166 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
 167        doc: /* Construct and return a new sparse keymap.
 168 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
 169 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
 170 which binds the function key or mouse event SYMBOL to DEFINITION.
 171 Initially the alist is nil.
 172
 173 The optional arg STRING supplies a menu name for the keymap
 174 in case you use it as a menu with `x-popup-menu'.  */)
 175      (string)
 176      Lisp_Object string;
 177 {
 178   if (!NILP (string))
 179     return Fcons (Qkeymap, Fcons (string, Qnil));
 180   return Fcons (Qkeymap, Qnil);
 181 }
 182
 183 /* This function is used for installing the standard key bindings
 184    at initialization time.
 185
 186    For example:
 187
 188    initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");  */
 189
 190 void
 191 initial_define_key (keymap, key, defname)
 192      Lisp_Object keymap;
 193      int key;
 194      char *defname;
 195 {
 196   store_in_keymap (keymap, make_number (key), intern (defname));
 197 }
 198
 199 void
 200 initial_define_lispy_key (keymap, keyname, defname)
 201      Lisp_Object keymap;
 202      char *keyname;
 203      char *defname;
 204 {
 205   store_in_keymap (keymap, intern (keyname), intern (defname));
 206 }
 207
 208 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
 209        doc: /* Return t if OBJECT is a keymap.
 210
 211 A keymap is a list (keymap . ALIST),
 212 or a symbol whose function definition is itself a keymap.
 213 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
 214 a vector of densely packed bindings for small character codes
 215 is also allowed as an element.  */)
 216      (object)
 217      Lisp_Object object;
 218 {
 219   return (KEYMAPP (object) ? Qt : Qnil);
 220 }
 221
 222 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
 223        doc: /* Return the prompt-string of a keymap MAP.
 224 If non-nil, the prompt is shown in the echo-area
 225 when reading a key-sequence to be looked-up in this keymap.  */)
 226      (map)
 227      Lisp_Object map;
 228 {
 229   map = get_keymap (map, 0, 0);
 230   while (CONSP (map))
 231     {
 232       Lisp_Object tem = XCAR (map);
 233       if (STRINGP (tem))
 234         return tem;
 235       map = XCDR (map);
 236     }
 237   return Qnil;
 238 }
 239
 240 /* Check that OBJECT is a keymap (after dereferencing through any
 241    symbols).  If it is, return it.
 242
 243    If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
 244    is an autoload form, do the autoload and try again.
 245    If AUTOLOAD is nonzero, callers must assume GC is possible.
 246
 247    If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
 248    is zero as well), return Qt.
 249
 250    ERROR controls how we respond if OBJECT isn't a keymap.
 251    If ERROR is non-zero, signal an error; otherwise, just return Qnil.
 252
 253    Note that most of the time, we don't want to pursue autoloads.
 254    Functions like Faccessible_keymaps which scan entire keymap trees
 255    shouldn't load every autoloaded keymap.  I'm not sure about this,
 256    but it seems to me that only read_key_sequence, Flookup_key, and
 257    Fdefine_key should cause keymaps to be autoloaded.
 258
 259    This function can GC when AUTOLOAD is non-zero, because it calls
 260    do_autoload which can GC.  */
 261
 262 Lisp_Object
 263 get_keymap (object, error, autoload)
 264      Lisp_Object object;
 265      int error, autoload;
 266 {
 267   Lisp_Object tem;
 268
 269  autoload_retry:
 270   if (NILP (object))
 271     goto end;
 272   if (CONSP (object) && EQ (XCAR (object), Qkeymap))
 273     return object;
 274
 275   tem = indirect_function (object);
 276   if (CONSP (tem))
 277     {
 278       if (EQ (XCAR (tem), Qkeymap))
 279         return tem;
 280
 281       /* Should we do an autoload?  Autoload forms for keymaps have
 282          Qkeymap as their fifth element.  */
 283       if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
 284           && SYMBOLP (object))
 285         {
 286           Lisp_Object tail;
 287
 288           tail = Fnth (make_number (4), tem);
 289           if (EQ (tail, Qkeymap))
 290             {
 291               if (autoload)
 292                 {
 293                   struct gcpro gcpro1, gcpro2;
 294
 295                   GCPRO2 (tem, object);
 296                   do_autoload (tem, object);
 297                   UNGCPRO;
 298
 299                   goto autoload_retry;
 300                 }
 301               else
 302                 return Qt;
 303             }
 304         }
 305     }
 306
 307  end:
 308   if (error)
 309     wrong_type_argument (Qkeymapp, object);
 310   return Qnil;
 311 }
 312 \f
 313 /* Return the parent map of KEYMAP, or nil if it has none.
 314    We assume that KEYMAP is a valid keymap.  */
 315
 316 Lisp_Object
 317 keymap_parent (keymap, autoload)
 318      Lisp_Object keymap;
 319      int autoload;
 320 {
 321   Lisp_Object list;
 322
 323   keymap = get_keymap (keymap, 1, autoload);
 324
 325   /* Skip past the initial element `keymap'.  */
 326   list = XCDR (keymap);
 327   for (; CONSP (list); list = XCDR (list))
 328     {
 329       /* See if there is another `keymap'.  */
 330       if (KEYMAPP (list))
 331         return list;
 332     }
 333
 334   return get_keymap (list, 0, autoload);
 335 }
 336
 337 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
 338        doc: /* Return the parent keymap of KEYMAP.  */)
 339      (keymap)
 340      Lisp_Object keymap;
 341 {
 342   return keymap_parent (keymap, 1);
 343 }
 344
 345 /* Check whether MAP is one of MAPS parents.  */
 346 int
 347 keymap_memberp (map, maps)
 348      Lisp_Object map, maps;
 349 {
 350   if (NILP (map)) return 0;
 351   while (KEYMAPP (maps) && !EQ (map, maps))
 352     maps = keymap_parent (maps, 0);
 353   return (EQ (map, maps));
 354 }
 355
 356 /* Set the parent keymap of MAP to PARENT.  */
 357
 358 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
 359        doc: /* Modify KEYMAP to set its parent map to PARENT.
 360 Return PARENT.  PARENT should be nil or another keymap.  */)
 361      (keymap, parent)
 362      Lisp_Object keymap, parent;
 363 {
 364   Lisp_Object list, prev;
 365   struct gcpro gcpro1, gcpro2;
 366   int i;
 367
 368   /* Force a keymap flush for the next call to where-is.
 369      Since this can be called from within where-is, we don't set where_is_cache
 370      directly but only where_is_cache_keymaps, since where_is_cache shouldn't
 371      be changed during where-is, while where_is_cache_keymaps is only used at
 372      the very beginning of where-is and can thus be changed here without any
 373      adverse effect.
 374      This is a very minor correctness (rather than safety) issue.  */
 375   where_is_cache_keymaps = Qt;
 376
 377   GCPRO2 (keymap, parent);
 378   keymap = get_keymap (keymap, 1, 1);
 379
 380   if (!NILP (parent))
 381     {
 382       parent = get_keymap (parent, 1, 1);
 383
 384       /* Check for cycles.  */
 385       if (keymap_memberp (keymap, parent))
 386         error ("Cyclic keymap inheritance");
 387     }
 388
 389   /* Skip past the initial element `keymap'.  */
 390   prev = keymap;
 391   while (1)
 392     {
 393       list = XCDR (prev);
 394       /* If there is a parent keymap here, replace it.
 395          If we came to the end, add the parent in PREV.  */
 396       if (!CONSP (list) || KEYMAPP (list))
 397         {
 398           /* If we already have the right parent, return now
 399              so that we avoid the loops below.  */
 400           if (EQ (XCDR (prev), parent))
 401             RETURN_UNGCPRO (parent);
 402
 403           CHECK_IMPURE (prev);
 404           XSETCDR (prev, parent);
 405           break;
 406         }
 407       prev = list;
 408     }
 409
 410   /* Scan through for submaps, and set their parents too.  */
 411
 412   for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
 413     {
 414       /* Stop the scan when we come to the parent.  */
 415       if (EQ (XCAR (list), Qkeymap))
 416         break;
 417
 418       /* If this element holds a prefix map, deal with it.  */
 419       if (CONSP (XCAR (list))
 420           && CONSP (XCDR (XCAR (list))))
 421         fix_submap_inheritance (keymap, XCAR (XCAR (list)),
 422                                 XCDR (XCAR (list)));
 423
 424       if (VECTORP (XCAR (list)))
 425         for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
 426           if (CONSP (XVECTOR (XCAR (list))->contents[i]))
 427             fix_submap_inheritance (keymap, make_number (i),
 428                                     XVECTOR (XCAR (list))->contents[i]);
 429
 430       if (CHAR_TABLE_P (XCAR (list)))
 431         {
 432           Lisp_Object indices[3];
 433
 434           map_char_table (fix_submap_inheritance, Qnil,
 435                           XCAR (list), XCAR (list),
 436                           keymap, 0, indices);
 437         }
 438     }
 439
 440   RETURN_UNGCPRO (parent);
 441 }
 442
 443 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
 444    if EVENT is also a prefix in MAP's parent,
 445    make sure that SUBMAP inherits that definition as its own parent.  */
 446
 447 static void
 448 fix_submap_inheritance (map, event, submap)
 449      Lisp_Object map, event, submap;
 450 {
 451   Lisp_Object map_parent, parent_entry;
 452
 453   /* SUBMAP is a cons that we found as a key binding.
 454      Discard the other things found in a menu key binding.  */
 455
 456   submap = get_keymap (get_keyelt (submap, 0), 0, 0);
 457
 458   /* If it isn't a keymap now, there's no work to do.  */
 459   if (!CONSP (submap))
 460     return;
 461
 462   map_parent = keymap_parent (map, 0);
 463   if (!NILP (map_parent))
 464     parent_entry =
 465       get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
 466   else
 467     parent_entry = Qnil;
 468
 469   /* If MAP's parent has something other than a keymap,
 470      our own submap shadows it completely.  */
 471   if (!CONSP (parent_entry))
 472     return;
 473
 474   if (! EQ (parent_entry, submap))
 475     {
 476       Lisp_Object submap_parent;
 477       submap_parent = submap;
 478       while (1)
 479         {
 480           Lisp_Object tem;
 481
 482           tem = keymap_parent (submap_parent, 0);
 483
 484           if (KEYMAPP (tem))
 485             {
 486               if (keymap_memberp (tem, parent_entry))
 487                 /* Fset_keymap_parent could create a cycle.  */
 488                 return;
 489               submap_parent = tem;
 490             }
 491           else
 492             break;
 493         }
 494       Fset_keymap_parent (submap_parent, parent_entry);
 495     }
 496 }
 497 \f
 498 /* Look up IDX in MAP.  IDX may be any sort of event.
 499    Note that this does only one level of lookup; IDX must be a single
 500    event, not a sequence.
 501
 502    If T_OK is non-zero, bindings for Qt are treated as default
 503    bindings; any key left unmentioned by other tables and bindings is
 504    given the binding of Qt.
 505
 506    If T_OK is zero, bindings for Qt are not treated specially.
 507
 508    If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */
 509
 510 Lisp_Object
 511 access_keymap (map, idx, t_ok, noinherit, autoload)
 512      Lisp_Object map;
 513      Lisp_Object idx;
 514      int t_ok;
 515      int noinherit;
 516      int autoload;
 517 {
 518   Lisp_Object val;
 519
 520   /* Qunbound in VAL means we have found no binding yet.  */
 521   val = Qunbound;
 522
 523   /* If idx is a list (some sort of mouse click, perhaps?),
 524      the index we want to use is the car of the list, which
 525      ought to be a symbol.  */
 526   idx = EVENT_HEAD (idx);
 527
 528   /* If idx is a symbol, it might have modifiers, which need to
 529      be put in the canonical order.  */
 530   if (SYMBOLP (idx))
 531     idx = reorder_modifiers (idx);
 532   else if (INTEGERP (idx))
 533     /* Clobber the high bits that can be present on a machine
 534        with more than 24 bits of integer.  */
 535     XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
 536
 537   /* Handle the special meta -> esc mapping. */
 538   if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
 539     {
 540       /* See if there is a meta-map.  If there's none, there is
 541          no binding for IDX, unless a default binding exists in MAP.  */
 542       struct gcpro gcpro1;
 543       Lisp_Object meta_map;
 544       GCPRO1 (map);
 545       /* A strange value in which Meta is set would cause
 546          infinite recursion.  Protect against that.  */
 547       if (XINT (meta_prefix_char) & CHAR_META)
 548         meta_prefix_char = make_number (27);
 549       meta_map = get_keymap (access_keymap (map, meta_prefix_char,
 550                                             t_ok, noinherit, autoload),
 551                              0, autoload);
 552       UNGCPRO;
 553       if (CONSP (meta_map))
 554         {
 555           map = meta_map;
 556           idx = make_number (XUINT (idx) & ~meta_modifier);
 557         }
 558       else if (t_ok)
 559         /* Set IDX to t, so that we only find a default binding.  */
 560         idx = Qt;
 561       else
 562         /* We know there is no binding.  */
 563         return Qnil;
 564     }
 565
 566   /* t_binding is where we put a default binding that applies,
 567      to use in case we do not find a binding specifically
 568      for this key sequence.  */
 569   {
 570     Lisp_Object tail;
 571     Lisp_Object t_binding = Qnil;
 572     struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 573
 574     GCPRO4 (map, tail, idx, t_binding);
 575
 576     /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
 577        If it is 1, only generic-char bindings are accepted.
 578        Otherwise, neither are.  */
 579     t_ok = t_ok ? 2 : 0;
 580
 581     for (tail = XCDR (map);
 582          (CONSP (tail)
 583           || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
 584          tail = XCDR (tail))
 585       {
 586         Lisp_Object binding;
 587
 588         binding = XCAR (tail);
 589         if (SYMBOLP (binding))
 590           {
 591             /* If NOINHERIT, stop finding prefix definitions
 592                after we pass a second occurrence of the `keymap' symbol.  */
 593             if (noinherit && EQ (binding, Qkeymap))
 594               RETURN_UNGCPRO (Qnil);
 595           }
 596         else if (CONSP (binding))
 597           {
 598             Lisp_Object key = XCAR (binding);
 599
 600             if (EQ (key, idx))
 601               val = XCDR (binding);
 602             else if (t_ok
 603                      && INTEGERP (idx)
 604                      && (XINT (idx) & CHAR_MODIFIER_MASK) == 0
 605                      && INTEGERP (key)
 606                      && (XINT (key) & CHAR_MODIFIER_MASK) == 0
 607                      && !SINGLE_BYTE_CHAR_P (XINT (idx))
 608                      && !SINGLE_BYTE_CHAR_P (XINT (key))
 609                      && CHAR_VALID_P (XINT (key), 1)
 610                      && !CHAR_VALID_P (XINT (key), 0)
 611                      && (CHAR_CHARSET (XINT (key))
 612                          == CHAR_CHARSET (XINT (idx))))
 613               {
 614                 /* KEY is the generic character of the charset of IDX.
 615                    Use KEY's binding if there isn't a binding for IDX
 616                    itself.  */
 617                 t_binding = XCDR (binding);
 618                 t_ok = 0;
 619               }
 620             else if (t_ok > 1 && EQ (key, Qt))
 621               {
 622                 t_binding = XCDR (binding);
 623                 t_ok = 1;
 624               }
 625           }
 626         else if (VECTORP (binding))
 627           {
 628             if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
 629               val = AREF (binding, XFASTINT (idx));
 630           }
 631         else if (CHAR_TABLE_P (binding))
 632           {
 633             /* Character codes with modifiers
 634                are not included in a char-table.
 635                All character codes without modifiers are included.  */
 636             if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
 637               {
 638                 val = Faref (binding, idx);
 639                 /* `nil' has a special meaning for char-tables, so
 640                    we use something else to record an explicitly
 641                    unbound entry.  */
 642                 if (NILP (val))
 643                   val = Qunbound;
 644               }
 645           }
 646
 647         /* If we found a binding, clean it up and return it.  */
 648         if (!EQ (val, Qunbound))
 649           {
 650             if (EQ (val, Qt))
 651               /* A Qt binding is just like an explicit nil binding
 652                  (i.e. it shadows any parent binding but not bindings in
 653                  keymaps of lower precedence).  */
 654               val = Qnil;
 655             val = get_keyelt (val, autoload);
 656             if (KEYMAPP (val))
 657               fix_submap_inheritance (map, idx, val);
 658             RETURN_UNGCPRO (val);
 659           }
 660         QUIT;
 661       }
 662     UNGCPRO;
 663     return get_keyelt (t_binding, autoload);
 664   }
 665 }
 666
 667 static void
 668 map_keymap_item (fun, args, key, val, data)
 669      map_keymap_function_t fun;
 670      Lisp_Object args, key, val;
 671      void *data;
 672 {
 673   /* We should maybe try to detect bindings shadowed by previous
 674      ones and things like that.  */
 675   if (EQ (val, Qt))
 676     val = Qnil;
 677   (*fun) (key, val, args, data);
 678 }
 679
 680 static void
 681 map_keymap_char_table_item (args, key, val)
 682      Lisp_Object args, key, val;
 683 {
 684   if (!NILP (val))
 685     {
 686       map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
 687       args = XCDR (args);
 688       map_keymap_item (fun, XCDR (args), key, val,
 689                        XSAVE_VALUE (XCAR (args))->pointer);
 690     }
 691 }
 692
 693 /* Call FUN for every binding in MAP.
 694    FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
 695    AUTOLOAD if non-zero means that we can autoload keymaps if necessary.  */
 696 void
 697 map_keymap (map, fun, args, data, autoload)
 698      map_keymap_function_t fun;
 699      Lisp_Object map, args;
 700      void *data;
 701      int autoload;
 702 {
 703   struct gcpro gcpro1, gcpro2, gcpro3;
 704   Lisp_Object tail;
 705
 706   tail = Qnil;
 707   GCPRO3 (map, args, tail);
 708   map = get_keymap (map, 1, autoload);
 709   for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
 710        CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
 711        tail = XCDR (tail))
 712     {
 713       Lisp_Object binding = XCAR (tail);
 714
 715       if (CONSP (binding))
 716         map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
 717       else if (VECTORP (binding))
 718         {
 719           /* Loop over the char values represented in the vector.  */
 720           int len = ASIZE (binding);
 721           int c;
 722           for (c = 0; c < len; c++)
 723             {
 724               Lisp_Object character;
 725               XSETFASTINT (character, c);
 726               map_keymap_item (fun, args, character, AREF (binding, c), data);
 727             }
 728         }
 729       else if (CHAR_TABLE_P (binding))
 730         {
 731           Lisp_Object indices[3];
 732           map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
 733                           Fcons (make_save_value (fun, 0),
 734                                  Fcons (make_save_value (data, 0),
 735                                         args)),
 736                           0, indices);
 737         }
 738     }
 739   UNGCPRO;
 740 }
 741
 742 static void
 743 map_keymap_call (key, val, fun, dummy)
 744      Lisp_Object key, val, fun;
 745      void *dummy;
 746 {
 747   call2 (fun, key, val);
 748 }
 749
 750 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
 751        doc: /* Call FUNCTION once for each event binding in KEYMAP.
 752 FUNCTION is called with two arguments: the event that is bound, and
 753 the definition it is bound to.  If the event is an integer, it may be
 754 a generic character (see Info node `(elisp)Splitting Characters'), and
 755 that means that all actual character events belonging to that generic
 756 character are bound to the definition.
 757
 758 If KEYMAP has a parent, the parent's bindings are included as well.
 759 This works recursively: if the parent has itself a parent, then the
 760 grandparent's bindings are also included and so on.
 761 usage: (map-keymap FUNCTION KEYMAP)  */)
 762      (function, keymap, sort_first)
 763      Lisp_Object function, keymap, sort_first;
 764 {
 765   if (INTEGERP (function))
 766     /* We have to stop integers early since map_keymap gives them special
 767        significance.  */
 768     xsignal1 (Qinvalid_function, function);
 769   if (! NILP (sort_first))
 770     return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
 771
 772   map_keymap (keymap, map_keymap_call, function, NULL, 1);
 773   return Qnil;
 774 }
 775
 776 /* Given OBJECT which was found in a slot in a keymap,
 777    trace indirect definitions to get the actual definition of that slot.
 778    An indirect definition is a list of the form
 779    (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
 780    and INDEX is the object to look up in KEYMAP to yield the definition.
 781
 782    Also if OBJECT has a menu string as the first element,
 783    remove that.  Also remove a menu help string as second element.
 784
 785    If AUTOLOAD is nonzero, load autoloadable keymaps
 786    that are referred to with indirection.
 787
 788    This can GC because menu_item_eval_property calls Feval.  */
 789
 790 Lisp_Object
 791 get_keyelt (object, autoload)
 792      Lisp_Object object;
 793      int autoload;
 794 {
 795   while (1)
 796     {
 797       if (!(CONSP (object)))
 798         /* This is really the value.  */
 799         return object;
 800
 801       /* If the keymap contents looks like (keymap ...) or (lambda ...)
 802          then use itself. */
 803       else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
 804         return object;
 805
 806       /* If the keymap contents looks like (menu-item name . DEFN)
 807          or (menu-item name DEFN ...) then use DEFN.
 808          This is a new format menu item.  */
 809       else if (EQ (XCAR (object), Qmenu_item))
 810         {
 811           if (CONSP (XCDR (object)))
 812             {
 813               Lisp_Object tem;
 814
 815               object = XCDR (XCDR (object));
 816               tem = object;
 817               if (CONSP (object))
 818                 object = XCAR (object);
 819
 820               /* If there's a `:filter FILTER', apply FILTER to the
 821                  menu-item's definition to get the real definition to
 822                  use.  */
 823               for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
 824                 if (EQ (XCAR (tem), QCfilter) && autoload)
 825                   {
 826                     Lisp_Object filter;
 827                     filter = XCAR (XCDR (tem));
 828                     filter = list2 (filter, list2 (Qquote, object));
 829                     object = menu_item_eval_property (filter);
 830                     break;
 831                   }
 832             }
 833           else
 834             /* Invalid keymap.  */
 835             return object;
 836         }
 837
 838       /* If the keymap contents looks like (STRING . DEFN), use DEFN.
 839          Keymap alist elements like (CHAR MENUSTRING . DEFN)
 840          will be used by HierarKey menus.  */
 841       else if (STRINGP (XCAR (object)))
 842         {
 843           object = XCDR (object);
 844           /* Also remove a menu help string, if any,
 845              following the menu item name.  */
 846           if (CONSP (object) && STRINGP (XCAR (object)))
 847             object = XCDR (object);
 848           /* Also remove the sublist that caches key equivalences, if any.  */
 849           if (CONSP (object) && CONSP (XCAR (object)))
 850             {
 851               Lisp_Object carcar;
 852               carcar = XCAR (XCAR (object));
 853               if (NILP (carcar) || VECTORP (carcar))
 854                 object = XCDR (object);
 855             }
 856         }
 857
 858       /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
 859       else
 860         {
 861           struct gcpro gcpro1;
 862           Lisp_Object map;
 863           GCPRO1 (object);
 864           map = get_keymap (Fcar_safe (object), 0, autoload);
 865           UNGCPRO;
 866           return (!CONSP (map) ? object /* Invalid keymap */
 867                   : access_keymap (map, Fcdr (object), 0, 0, autoload));
 868         }
 869     }
 870 }
 871
 872 static Lisp_Object
 873 store_in_keymap (keymap, idx, def)
 874      Lisp_Object keymap;
 875      register Lisp_Object idx;
 876      Lisp_Object def;
 877 {
 878   /* Flush any reverse-map cache.  */
 879   where_is_cache = Qnil;
 880   where_is_cache_keymaps = Qt;
 881
 882   /* If we are preparing to dump, and DEF is a menu element
 883      with a menu item indicator, copy it to ensure it is not pure.  */
 884   if (CONSP (def) && PURE_P (def)
 885       && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
 886     def = Fcons (XCAR (def), XCDR (def));
 887
 888   if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
 889     error ("attempt to define a key in a non-keymap");
 890
 891   /* If idx is a list (some sort of mouse click, perhaps?),
 892      the index we want to use is the car of the list, which
 893      ought to be a symbol.  */
 894   idx = EVENT_HEAD (idx);
 895
 896   /* If idx is a symbol, it might have modifiers, which need to
 897      be put in the canonical order.  */
 898   if (SYMBOLP (idx))
 899     idx = reorder_modifiers (idx);
 900   else if (INTEGERP (idx))
 901     /* Clobber the high bits that can be present on a machine
 902        with more than 24 bits of integer.  */
 903     XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
 904
 905   /* Scan the keymap for a binding of idx.  */
 906   {
 907     Lisp_Object tail;
 908
 909     /* The cons after which we should insert new bindings.  If the
 910        keymap has a table element, we record its position here, so new
 911        bindings will go after it; this way, the table will stay
 912        towards the front of the alist and character lookups in dense
 913        keymaps will remain fast.  Otherwise, this just points at the
 914        front of the keymap.  */
 915     Lisp_Object insertion_point;
 916
 917     insertion_point = keymap;
 918     for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
 919       {
 920         Lisp_Object elt;
 921
 922         elt = XCAR (tail);
 923         if (VECTORP (elt))
 924           {
 925             if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
 926               {
 927                 CHECK_IMPURE (elt);
 928                 ASET (elt, XFASTINT (idx), def);
 929                 return def;
 930               }
 931             insertion_point = tail;
 932           }
 933         else if (CHAR_TABLE_P (elt))
 934           {
 935             /* Character codes with modifiers
 936                are not included in a char-table.
 937                All character codes without modifiers are included.  */
 938             if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
 939               {
 940                 Faset (elt, idx,
 941                        /* `nil' has a special meaning for char-tables, so
 942                           we use something else to record an explicitly
 943                           unbound entry.  */
 944                        NILP (def) ? Qt : def);
 945                 return def;
 946               }
 947             insertion_point = tail;
 948           }
 949         else if (CONSP (elt))
 950           {
 951             if (EQ (idx, XCAR (elt)))
 952               {
 953                 CHECK_IMPURE (elt);
 954                 XSETCDR (elt, def);
 955                 return def;
 956               }
 957           }
 958         else if (EQ (elt, Qkeymap))
 959           /* If we find a 'keymap' symbol in the spine of KEYMAP,
 960              then we must have found the start of a second keymap
 961              being used as the tail of KEYMAP, and a binding for IDX
 962              should be inserted before it.  */
 963           goto keymap_end;
 964
 965         QUIT;
 966       }
 967
 968   keymap_end:
 969     /* We have scanned the entire keymap, and not found a binding for
 970        IDX.  Let's add one.  */
 971     CHECK_IMPURE (insertion_point);
 972     XSETCDR (insertion_point,
 973              Fcons (Fcons (idx, def), XCDR (insertion_point)));
 974   }
 975
 976   return def;
 977 }
 978
 979 EXFUN (Fcopy_keymap, 1);
 980
 981 Lisp_Object
 982 copy_keymap_item (elt)
 983      Lisp_Object elt;
 984 {
 985   Lisp_Object res, tem;
 986
 987   if (!CONSP (elt))
 988     return elt;
 989
 990   res = tem = elt;
 991
 992   /* Is this a new format menu item.  */
 993   if (EQ (XCAR (tem), Qmenu_item))
 994     {
 995       /* Copy cell with menu-item marker.  */
 996       res = elt = Fcons (XCAR (tem), XCDR (tem));
 997       tem = XCDR (elt);
 998       if (CONSP (tem))
 999         {
1000           /* Copy cell with menu-item name.  */
1001           XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1002           elt = XCDR (elt);
1003           tem = XCDR (elt);
1004         }
1005       if (CONSP (tem))
1006         {
1007           /* Copy cell with binding and if the binding is a keymap,
1008              copy that.  */
1009           XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1010           elt = XCDR (elt);
1011           tem = XCAR (elt);
1012           if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1013             XSETCAR (elt, Fcopy_keymap (tem));
1014           tem = XCDR (elt);
1015           if (CONSP (tem) && CONSP (XCAR (tem)))
1016             /* Delete cache for key equivalences.  */
1017             XSETCDR (elt, XCDR (tem));
1018         }
1019     }
1020   else
1021     {
1022       /* It may be an old fomat menu item.
1023          Skip the optional menu string.  */
1024       if (STRINGP (XCAR (tem)))
1025         {
1026           /* Copy the cell, since copy-alist didn't go this deep.  */
1027           res = elt = Fcons (XCAR (tem), XCDR (tem));
1028           tem = XCDR (elt);
1029           /* Also skip the optional menu help string.  */
1030           if (CONSP (tem) && STRINGP (XCAR (tem)))
1031             {
1032               XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1033               elt = XCDR (elt);
1034               tem = XCDR (elt);
1035             }
1036           /* There may also be a list that caches key equivalences.
1037              Just delete it for the new keymap.  */
1038           if (CONSP (tem)
1039               && CONSP (XCAR (tem))
1040               && (NILP (XCAR (XCAR (tem)))
1041                   || VECTORP (XCAR (XCAR (tem)))))
1042             {
1043               XSETCDR (elt, XCDR (tem));
1044               tem = XCDR (tem);
1045             }
1046           if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1047             XSETCDR (elt, Fcopy_keymap (tem));
1048         }
1049       else if (EQ (XCAR (tem), Qkeymap))
1050         res = Fcopy_keymap (elt);
1051     }
1052   return res;
1053 }
1054
1055 static void
1056 copy_keymap_1 (chartable, idx, elt)
1057      Lisp_Object chartable, idx, elt;
1058 {
1059   Faset (chartable, idx, copy_keymap_item (elt));
1060 }
1061
1062 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1063        doc: /* Return a copy of the keymap KEYMAP.
1064 The copy starts out with the same definitions of KEYMAP,
1065 but changing either the copy or KEYMAP does not affect the other.
1066 Any key definitions that are subkeymaps are recursively copied.
1067 However, a key definition which is a symbol whose definition is a keymap
1068 is not copied.  */)
1069      (keymap)
1070      Lisp_Object keymap;
1071 {
1072   register Lisp_Object copy, tail;
1073   keymap = get_keymap (keymap, 1, 0);
1074   copy = tail = Fcons (Qkeymap, Qnil);
1075   keymap = XCDR (keymap);               /* Skip the `keymap' symbol.  */
1076
1077   while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1078     {
1079       Lisp_Object elt = XCAR (keymap);
1080       if (CHAR_TABLE_P (elt))
1081         {
1082           Lisp_Object indices[3];
1083           elt = Fcopy_sequence (elt);
1084           map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
1085         }
1086       else if (VECTORP (elt))
1087         {
1088           int i;
1089           elt = Fcopy_sequence (elt);
1090           for (i = 0; i < ASIZE (elt); i++)
1091             ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1092         }
1093       else if (CONSP (elt))
1094         elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1095       XSETCDR (tail, Fcons (elt, Qnil));
1096       tail = XCDR (tail);
1097       keymap = XCDR (keymap);
1098     }
1099   XSETCDR (tail, keymap);
1100   return copy;
1101 }
1102 \f
1103 /* Simple Keymap mutators and accessors.                                */
1104
1105 /* GC is possible in this function if it autoloads a keymap.  */
1106
1107 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1108        doc: /* In KEYMAP, define key sequence KEY as DEF.
1109 KEYMAP is a keymap.
1110
1111 KEY is a string or a vector of symbols and characters meaning a
1112 sequence of keystrokes and events.  Non-ASCII characters with codes
1113 above 127 (such as ISO Latin-1) can be included if you use a vector.
1114 Using [t] for KEY creates a default definition, which applies to any
1115 event type that has no other definition in this keymap.
1116
1117 DEF is anything that can be a key's definition:
1118  nil (means key is undefined in this keymap),
1119  a command (a Lisp function suitable for interactive calling),
1120  a string (treated as a keyboard macro),
1121  a keymap (to define a prefix key),
1122  a symbol (when the key is looked up, the symbol will stand for its
1123     function definition, which should at that time be one of the above,
1124     or another symbol whose function definition is used, etc.),
1125  a cons (STRING . DEFN), meaning that DEFN is the definition
1126     (DEFN should be a valid definition in its own right),
1127  or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1128  or an extended menu item definition.
1129  (See info node `(elisp)Extended Menu Items'.)
1130
1131 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1132 binding is altered.  If there is no binding for KEY, the new pair
1133 binding KEY to DEF is added at the front of KEYMAP.  */)
1134      (keymap, key, def)
1135      Lisp_Object keymap;
1136      Lisp_Object key;
1137      Lisp_Object def;
1138 {
1139   register int idx;
1140   register Lisp_Object c;
1141   register Lisp_Object cmd;
1142   int metized = 0;
1143   int meta_bit;
1144   int length;
1145   struct gcpro gcpro1, gcpro2, gcpro3;
1146
1147   GCPRO3 (keymap, key, def);
1148   keymap = get_keymap (keymap, 1, 1);
1149
1150   CHECK_VECTOR_OR_STRING (key);
1151
1152   length = XFASTINT (Flength (key));
1153   if (length == 0)
1154     RETURN_UNGCPRO (Qnil);
1155
1156   if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1157     Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1158
1159   meta_bit = VECTORP (key) ? meta_modifier : 0x80;
1160
1161   if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1162     { /* DEF is apparently an XEmacs-style keyboard macro.  */
1163       Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1164       int i = ASIZE (def);
1165       while (--i >= 0)
1166         {
1167           Lisp_Object c = AREF (def, i);
1168           if (CONSP (c) && lucid_event_type_list_p (c))
1169             c = Fevent_convert_list (c);
1170           ASET (tmp, i, c);
1171         }
1172       def = tmp;
1173     }
1174
1175   idx = 0;
1176   while (1)
1177     {
1178       c = Faref (key, make_number (idx));
1179
1180       if (CONSP (c) && lucid_event_type_list_p (c))
1181         c = Fevent_convert_list (c);
1182
1183       if (SYMBOLP (c))
1184         silly_event_symbol_error (c);
1185
1186       if (INTEGERP (c)
1187           && (XINT (c) & meta_bit)
1188           && !metized)
1189         {
1190           c = meta_prefix_char;
1191           metized = 1;
1192         }
1193       else
1194         {
1195           if (INTEGERP (c))
1196             XSETINT (c, XINT (c) & ~meta_bit);
1197
1198           metized = 0;
1199           idx++;
1200         }
1201
1202       if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
1203         error ("Key sequence contains invalid event");
1204
1205       if (idx == length)
1206         RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1207
1208       cmd = access_keymap (keymap, c, 0, 1, 1);
1209
1210       /* If this key is undefined, make it a prefix.  */
1211       if (NILP (cmd))
1212         cmd = define_as_prefix (keymap, c);
1213
1214       keymap = get_keymap (cmd, 0, 1);
1215       if (!CONSP (keymap))
1216         /* We must use Fkey_description rather than just passing key to
1217            error; key might be a vector, not a string.  */
1218         error ("Key sequence %s starts with non-prefix key %s",
1219                SDATA (Fkey_description (key, Qnil)),
1220                SDATA (Fkey_description (Fsubstring (key, make_number (0),
1221                                                     make_number (idx)),
1222                                         Qnil)));
1223     }
1224 }
1225
1226 /* This function may GC (it calls Fkey_binding).  */
1227
1228 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1229        doc: /* Return the remapping for command COMMAND.
1230 Returns nil if COMMAND is not remapped (or not a symbol).
1231
1232 If the optional argument POSITION is non-nil, it specifies a mouse
1233 position as returned by `event-start' and `event-end', and the
1234 remapping occurs in the keymaps associated with it.  It can also be a
1235 number or marker, in which case the keymap properties at the specified
1236 buffer position instead of point are used.  The KEYMAPS argument is
1237 ignored if POSITION is non-nil.
1238
1239 If the optional argument KEYMAPS is non-nil, it should be a list of
1240 keymaps to search for command remapping.  Otherwise, search for the
1241 remapping in all currently active keymaps.  */)
1242      (command, position, keymaps)
1243      Lisp_Object command, position, keymaps;
1244 {
1245   if (!SYMBOLP (command))
1246     return Qnil;
1247
1248   ASET (command_remapping_vector, 1, command);
1249
1250   if (NILP (keymaps))
1251     return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1252   else
1253     {
1254       Lisp_Object maps, binding;
1255
1256       for (maps = keymaps; !NILP (maps); maps = Fcdr (maps))
1257         {
1258           binding = Flookup_key (Fcar (maps), command_remapping_vector, Qnil);
1259           if (!NILP (binding) && !INTEGERP (binding))
1260             return binding;
1261         }
1262       return Qnil;
1263     }
1264 }
1265
1266 /* Value is number if KEY is too long; nil if valid but has no definition. */
1267 /* GC is possible in this function if it autoloads a keymap.  */
1268
1269 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1270        doc: /* In keymap KEYMAP, look up key sequence KEY.  Return the definition.
1271 A value of nil means undefined.  See doc of `define-key'
1272 for kinds of definitions.
1273
1274 A number as value means KEY is "too long";
1275 that is, characters or symbols in it except for the last one
1276 fail to be a valid sequence of prefix characters in KEYMAP.
1277 The number is how many characters at the front of KEY
1278 it takes to reach a non-prefix key.
1279
1280 Normally, `lookup-key' ignores bindings for t, which act as default
1281 bindings, used when nothing else in the keymap applies; this makes it
1282 usable as a general function for probing keymaps.  However, if the
1283 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1284 recognize the default bindings, just as `read-key-sequence' does.  */)
1285      (keymap, key, accept_default)
1286      Lisp_Object keymap;
1287      Lisp_Object key;
1288      Lisp_Object accept_default;
1289 {
1290   register int idx;
1291   register Lisp_Object cmd;
1292   register Lisp_Object c;
1293   int length;
1294   int t_ok = !NILP (accept_default);
1295   struct gcpro gcpro1, gcpro2;
1296
1297   GCPRO2 (keymap, key);
1298   keymap = get_keymap (keymap, 1, 1);
1299
1300   CHECK_VECTOR_OR_STRING (key);
1301
1302   length = XFASTINT (Flength (key));
1303   if (length == 0)
1304     RETURN_UNGCPRO (keymap);
1305
1306   idx = 0;
1307   while (1)
1308     {
1309       c = Faref (key, make_number (idx++));
1310
1311       if (CONSP (c) && lucid_event_type_list_p (c))
1312         c = Fevent_convert_list (c);
1313
1314       /* Turn the 8th bit of string chars into a meta modifier.  */
1315       if (INTEGERP (c) && XINT (c) & 0x80 && STRINGP (key))
1316         XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1317
1318       /* Allow string since binding for `menu-bar-select-buffer'
1319          includes the buffer name in the key sequence.  */
1320       if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1321         error ("Key sequence contains invalid event");
1322
1323       cmd = access_keymap (keymap, c, t_ok, 0, 1);
1324       if (idx == length)
1325         RETURN_UNGCPRO (cmd);
1326
1327       keymap = get_keymap (cmd, 0, 1);
1328       if (!CONSP (keymap))
1329         RETURN_UNGCPRO (make_number (idx));
1330
1331       QUIT;
1332     }
1333 }
1334
1335 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1336    Assume that currently it does not define C at all.
1337    Return the keymap.  */
1338
1339 static Lisp_Object
1340 define_as_prefix (keymap, c)
1341      Lisp_Object keymap, c;
1342 {
1343   Lisp_Object cmd;
1344
1345   cmd = Fmake_sparse_keymap (Qnil);
1346   /* If this key is defined as a prefix in an inherited keymap,
1347      make it a prefix in this map, and make its definition
1348      inherit the other prefix definition.  */
1349   cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1350   store_in_keymap (keymap, c, cmd);
1351
1352   return cmd;
1353 }
1354
1355 /* Append a key to the end of a key sequence.  We always make a vector.  */
1356
1357 Lisp_Object
1358 append_key (key_sequence, key)
1359      Lisp_Object key_sequence, key;
1360 {
1361   Lisp_Object args[2];
1362
1363   args[0] = key_sequence;
1364
1365   args[1] = Fcons (key, Qnil);
1366   return Fvconcat (2, args);
1367 }
1368
1369 /* Given a event type C which is a symbol,
1370    signal an error if is a mistake such as RET or M-RET or C-DEL, etc.  */
1371
1372 static void
1373 silly_event_symbol_error (c)
1374      Lisp_Object c;
1375 {
1376   Lisp_Object parsed, base, name, assoc;
1377   int modifiers;
1378
1379   parsed = parse_modifiers (c);
1380   modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1381   base = XCAR (parsed);
1382   name = Fsymbol_name (base);
1383   /* This alist includes elements such as ("RET" . "\\r").  */
1384   assoc = Fassoc (name, exclude_keys);
1385
1386   if (! NILP (assoc))
1387     {
1388       char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1389       char *p = new_mods;
1390       Lisp_Object keystring;
1391       if (modifiers & alt_modifier)
1392         { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1393       if (modifiers & ctrl_modifier)
1394         { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1395       if (modifiers & hyper_modifier)
1396         { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1397       if (modifiers & meta_modifier)
1398         { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1399       if (modifiers & shift_modifier)
1400         { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1401       if (modifiers & super_modifier)
1402         { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1403       *p = 0;
1404
1405       c = reorder_modifiers (c);
1406       keystring = concat2 (build_string (new_mods), XCDR (assoc));
1407
1408       error ((modifiers & ~meta_modifier
1409               ? "To bind the key %s, use [?%s], not [%s]"
1410               : "To bind the key %s, use \"%s\", not [%s]"),
1411              SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1412              SDATA (SYMBOL_NAME (c)));
1413     }
1414 }
1415 \f
1416 /* Global, local, and minor mode keymap stuff.                          */
1417
1418 /* We can't put these variables inside current_minor_maps, since under
1419    some systems, static gets macro-defined to be the empty string.
1420    Ickypoo.  */
1421 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1422 static int cmm_size = 0;
1423
1424 /* Store a pointer to an array of the currently active minor modes in
1425    *modeptr, a pointer to an array of the keymaps of the currently
1426    active minor modes in *mapptr, and return the number of maps
1427    *mapptr contains.
1428
1429    This function always returns a pointer to the same buffer, and may
1430    free or reallocate it, so if you want to keep it for a long time or
1431    hand it out to lisp code, copy it.  This procedure will be called
1432    for every key sequence read, so the nice lispy approach (return a
1433    new assoclist, list, what have you) for each invocation would
1434    result in a lot of consing over time.
1435
1436    If we used xrealloc/xmalloc and ran out of memory, they would throw
1437    back to the command loop, which would try to read a key sequence,
1438    which would call this function again, resulting in an infinite
1439    loop.  Instead, we'll use realloc/malloc and silently truncate the
1440    list, let the key sequence be read, and hope some other piece of
1441    code signals the error.  */
1442 int
1443 current_minor_maps (modeptr, mapptr)
1444      Lisp_Object **modeptr, **mapptr;
1445 {
1446   int i = 0;
1447   int list_number = 0;
1448   Lisp_Object alist, assoc, var, val;
1449   Lisp_Object emulation_alists;
1450   Lisp_Object lists[2];
1451
1452   emulation_alists = Vemulation_mode_map_alists;
1453   lists[0] = Vminor_mode_overriding_map_alist;
1454   lists[1] = Vminor_mode_map_alist;
1455
1456   for (list_number = 0; list_number < 2; list_number++)
1457     {
1458       if (CONSP (emulation_alists))
1459         {
1460           alist = XCAR (emulation_alists);
1461           emulation_alists = XCDR (emulation_alists);
1462           if (SYMBOLP (alist))
1463             alist = find_symbol_value (alist);
1464           list_number = -1;
1465         }
1466       else
1467         alist = lists[list_number];
1468
1469       for ( ; CONSP (alist); alist = XCDR (alist))
1470         if ((assoc = XCAR (alist), CONSP (assoc))
1471             && (var = XCAR (assoc), SYMBOLP (var))
1472             && (val = find_symbol_value (var), !EQ (val, Qunbound))
1473             && !NILP (val))
1474           {
1475             Lisp_Object temp;
1476
1477             /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1478                and also an entry in Vminor_mode_map_alist,
1479                ignore the latter.  */
1480             if (list_number == 1)
1481               {
1482                 val = assq_no_quit (var, lists[0]);
1483                 if (!NILP (val))
1484                   continue;
1485               }
1486
1487             if (i >= cmm_size)
1488               {
1489                 int newsize, allocsize;
1490                 Lisp_Object *newmodes, *newmaps;
1491
1492                 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1493                 allocsize = newsize * sizeof *newmodes;
1494
1495                 /* Use malloc here.  See the comment above this function.
1496                    Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1497                 BLOCK_INPUT;
1498                 newmodes = (Lisp_Object *) malloc (allocsize);
1499                 if (newmodes)
1500                   {
1501                     if (cmm_modes)
1502                       {
1503                         bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1504                         free (cmm_modes);
1505                       }
1506                     cmm_modes = newmodes;
1507                   }
1508
1509                 newmaps = (Lisp_Object *) malloc (allocsize);
1510                 if (newmaps)
1511                   {
1512                     if (cmm_maps)
1513                       {
1514                         bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1515                         free (cmm_maps);
1516                       }
1517                     cmm_maps = newmaps;
1518                   }
1519                 UNBLOCK_INPUT;
1520
1521                 if (newmodes == NULL || newmaps == NULL)
1522                   break;
1523                 cmm_size = newsize;
1524               }
1525
1526             /* Get the keymap definition--or nil if it is not defined.  */
1527             temp = Findirect_function (XCDR (assoc), Qt);
1528             if (!NILP (temp))
1529               {
1530                 cmm_modes[i] = var;
1531                 cmm_maps [i] = temp;
1532                 i++;
1533               }
1534           }
1535     }
1536
1537   if (modeptr) *modeptr = cmm_modes;
1538   if (mapptr)  *mapptr  = cmm_maps;
1539   return i;
1540 }
1541
1542 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1543        0, 1, 0,
1544        doc: /* Return a list of the currently active keymaps.
1545 OLP if non-nil indicates that we should obey `overriding-local-map' and
1546 `overriding-terminal-local-map'.  */)
1547      (olp)
1548      Lisp_Object olp;
1549 {
1550   Lisp_Object keymaps = Fcons (current_global_map, Qnil);
1551
1552   if (!NILP (olp))
1553     {
1554       if (!NILP (current_kboard->Voverriding_terminal_local_map))
1555         keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1556       /* The doc said that overriding-terminal-local-map should
1557          override overriding-local-map.  The code used them both,
1558          but it seems clearer to use just one.  rms, jan 2005.  */
1559       else if (!NILP (Voverriding_local_map))
1560         keymaps = Fcons (Voverriding_local_map, keymaps);
1561     }
1562   if (NILP (XCDR (keymaps)))
1563     {
1564       Lisp_Object local;
1565       Lisp_Object *maps;
1566       int nmaps, i;
1567
1568       /* This usually returns the buffer's local map,
1569          but that can be overridden by a `local-map' property.  */
1570       local = get_local_map (PT, current_buffer, Qlocal_map);
1571       if (!NILP (local))
1572         keymaps = Fcons (local, keymaps);
1573
1574       /* Now put all the minor mode keymaps on the list.  */
1575       nmaps = current_minor_maps (0, &maps);
1576
1577       for (i = --nmaps; i >= 0; i--)
1578         if (!NILP (maps[i]))
1579           keymaps = Fcons (maps[i], keymaps);
1580
1581       /* This returns nil unless there is a `keymap' property.  */
1582       local = get_local_map (PT, current_buffer, Qkeymap);
1583       if (!NILP (local))
1584         keymaps = Fcons (local, keymaps);
1585     }
1586
1587   return keymaps;
1588 }
1589
1590 /* GC is possible in this function if it autoloads a keymap.  */
1591
1592 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1593        doc: /* Return the binding for command KEY in current keymaps.
1594 KEY is a string or vector, a sequence of keystrokes.
1595 The binding is probably a symbol with a function definition.
1596
1597 Normally, `key-binding' ignores bindings for t, which act as default
1598 bindings, used when nothing else in the keymap applies; this makes it
1599 usable as a general function for probing keymaps.  However, if the
1600 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1601 recognize the default bindings, just as `read-key-sequence' does.
1602
1603 Like the normal command loop, `key-binding' will remap the command
1604 resulting from looking up KEY by looking up the command in the
1605 current keymaps.  However, if the optional third argument NO-REMAP
1606 is non-nil, `key-binding' returns the unmapped command.
1607
1608 If KEY is a key sequence initiated with the mouse, the used keymaps
1609 will depend on the clicked mouse position with regard to the buffer
1610 and possible local keymaps on strings.
1611
1612 If the optional argument POSITION is non-nil, it specifies a mouse
1613 position as returned by `event-start' and `event-end', and the lookup
1614 occurs in the keymaps associated with it instead of KEY.  It can also
1615 be a number or marker, in which case the keymap properties at the
1616 specified buffer position instead of point are used.
1617   */)
1618     (key, accept_default, no_remap, position)
1619     Lisp_Object key, accept_default, no_remap, position;
1620 {
1621   Lisp_Object *maps, value;
1622   int nmaps, i;
1623   struct gcpro gcpro1, gcpro2;
1624   int count = SPECPDL_INDEX ();
1625
1626   GCPRO2 (key, position);
1627
1628   if (NILP (position) && VECTORP (key))
1629     {
1630       Lisp_Object event
1631         /* mouse events may have a symbolic prefix indicating the
1632            scrollbar or mode line */
1633         = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1634
1635       /* We are not interested in locations without event data */
1636
1637       if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1638         {
1639           Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1640           if (EQ (kind, Qmouse_click))
1641             position = EVENT_START (event);
1642         }
1643     }
1644
1645   /* Key sequences beginning with mouse clicks
1646      are read using the keymaps of the buffer clicked on, not
1647      the current buffer.  So we may have to switch the buffer
1648      here. */
1649
1650   if (CONSP (position))
1651     {
1652       Lisp_Object window;
1653
1654       window = POSN_WINDOW (position);
1655
1656       if (WINDOWP (window)
1657           && BUFFERP (XWINDOW (window)->buffer)
1658           && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1659         {
1660           /* Arrange to go back to the original buffer once we're done
1661              processing the key sequence.  We don't use
1662              save_excursion_{save,restore} here, in analogy to
1663              `read-key-sequence' to avoid saving point.  Maybe this
1664              would not be a problem here, but it is easier to keep
1665              things the same.
1666           */
1667
1668           record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1669
1670           set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1671         }
1672     }
1673
1674   if (! NILP (current_kboard->Voverriding_terminal_local_map))
1675     {
1676       value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1677                            key, accept_default);
1678       if (! NILP (value) && !INTEGERP (value))
1679         goto done;
1680     }
1681   else if (! NILP (Voverriding_local_map))
1682     {
1683       value = Flookup_key (Voverriding_local_map, key, accept_default);
1684       if (! NILP (value) && !INTEGERP (value))
1685         goto done;
1686     }
1687   else
1688     {
1689       Lisp_Object keymap, local_map;
1690       EMACS_INT pt;
1691
1692       pt = INTEGERP (position) ? XINT (position)
1693         : MARKERP (position) ? marker_position (position)
1694         : PT;
1695
1696       local_map = get_local_map (pt, current_buffer, Qlocal_map);
1697       keymap = get_local_map (pt, current_buffer, Qkeymap);
1698
1699       if (CONSP (position))
1700         {
1701           Lisp_Object string;
1702
1703           /* For a mouse click, get the local text-property keymap
1704              of the place clicked on, rather than point.  */
1705
1706           if (POSN_INBUFFER_P (position))
1707             {
1708               Lisp_Object pos;
1709
1710               pos = POSN_BUFFER_POSN (position);
1711               if (INTEGERP (pos)
1712                   && XINT (pos) >= BEG && XINT (pos) <= Z)
1713                 {
1714                   local_map = get_local_map (XINT (pos),
1715                                              current_buffer, Qlocal_map);
1716
1717                   keymap = get_local_map (XINT (pos),
1718                                           current_buffer, Qkeymap);
1719                 }
1720             }
1721
1722           /* If on a mode line string with a local keymap,
1723              or for a click on a string, i.e. overlay string or a
1724              string displayed via the `display' property,
1725              consider `local-map' and `keymap' properties of
1726              that string.  */
1727
1728           if (string = POSN_STRING (position),
1729               (CONSP (string) && STRINGP (XCAR (string))))
1730             {
1731               Lisp_Object pos, map;
1732
1733               pos = XCDR (string);
1734               string = XCAR (string);
1735               if (INTEGERP (pos)
1736                   && XINT (pos) >= 0
1737                   && XINT (pos) < SCHARS (string))
1738                 {
1739                   map = Fget_text_property (pos, Qlocal_map, string);
1740                   if (!NILP (map))
1741                     local_map = map;
1742
1743                   map = Fget_text_property (pos, Qkeymap, string);
1744                   if (!NILP (map))
1745                     keymap = map;
1746                 }
1747             }
1748
1749         }
1750
1751       if (! NILP (keymap))
1752         {
1753           value = Flookup_key (keymap, key, accept_default);
1754           if (! NILP (value) && !INTEGERP (value))
1755             goto done;
1756         }
1757
1758       nmaps = current_minor_maps (0, &maps);
1759       /* Note that all these maps are GCPRO'd
1760          in the places where we found them.  */
1761
1762       for (i = 0; i < nmaps; i++)
1763         if (! NILP (maps[i]))
1764           {
1765             value = Flookup_key (maps[i], key, accept_default);
1766             if (! NILP (value) && !INTEGERP (value))
1767               goto done;
1768           }
1769
1770       if (! NILP (local_map))
1771         {
1772           value = Flookup_key (local_map, key, accept_default);
1773           if (! NILP (value) && !INTEGERP (value))
1774             goto done;
1775         }
1776     }
1777
1778   value = Flookup_key (current_global_map, key, accept_default);
1779
1780  done:
1781   unbind_to (count, Qnil);
1782
1783   UNGCPRO;
1784   if (NILP (value) || INTEGERP (value))
1785     return Qnil;
1786
1787   /* If the result of the ordinary keymap lookup is an interactive
1788      command, look for a key binding (ie. remapping) for that command.  */
1789
1790   if (NILP (no_remap) && SYMBOLP (value))
1791     {
1792       Lisp_Object value1;
1793       if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1794         value = value1;
1795     }
1796
1797   return value;
1798 }
1799
1800 /* GC is possible in this function if it autoloads a keymap.  */
1801
1802 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1803        doc: /* Return the binding for command KEYS in current local keymap only.
1804 KEYS is a string or vector, a sequence of keystrokes.
1805 The binding is probably a symbol with a function definition.
1806
1807 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1808 bindings; see the description of `lookup-key' for more details about this.  */)
1809      (keys, accept_default)
1810      Lisp_Object keys, accept_default;
1811 {
1812   register Lisp_Object map;
1813   map = current_buffer->keymap;
1814   if (NILP (map))
1815     return Qnil;
1816   return Flookup_key (map, keys, accept_default);
1817 }
1818
1819 /* GC is possible in this function if it autoloads a keymap.  */
1820
1821 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1822        doc: /* Return the binding for command KEYS in current global keymap only.
1823 KEYS is a string or vector, a sequence of keystrokes.
1824 The binding is probably a symbol with a function definition.
1825 This function's return values are the same as those of `lookup-key'
1826 \(which see).
1827
1828 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1829 bindings; see the description of `lookup-key' for more details about this.  */)
1830      (keys, accept_default)
1831      Lisp_Object keys, accept_default;
1832 {
1833   return Flookup_key (current_global_map, keys, accept_default);
1834 }
1835
1836 /* GC is possible in this function if it autoloads a keymap.  */
1837
1838 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1839        doc: /* Find the visible minor mode bindings of KEY.
1840 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1841 the symbol which names the minor mode binding KEY, and BINDING is
1842 KEY's definition in that mode.  In particular, if KEY has no
1843 minor-mode bindings, return nil.  If the first binding is a
1844 non-prefix, all subsequent bindings will be omitted, since they would
1845 be ignored.  Similarly, the list doesn't include non-prefix bindings
1846 that come after prefix bindings.
1847
1848 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1849 bindings; see the description of `lookup-key' for more details about this.  */)
1850      (key, accept_default)
1851      Lisp_Object key, accept_default;
1852 {
1853   Lisp_Object *modes, *maps;
1854   int nmaps;
1855   Lisp_Object binding;
1856   int i, j;
1857   struct gcpro gcpro1, gcpro2;
1858
1859   nmaps = current_minor_maps (&modes, &maps);
1860   /* Note that all these maps are GCPRO'd
1861      in the places where we found them.  */
1862
1863   binding = Qnil;
1864   GCPRO2 (key, binding);
1865
1866   for (i = j = 0; i < nmaps; i++)
1867     if (!NILP (maps[i])
1868         && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1869         && !INTEGERP (binding))
1870       {
1871         if (KEYMAPP (binding))
1872           maps[j++] = Fcons (modes[i], binding);
1873         else if (j == 0)
1874           RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1875       }
1876
1877   UNGCPRO;
1878   return Flist (j, maps);
1879 }
1880
1881 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1882        doc: /* Define COMMAND as a prefix command.  COMMAND should be a symbol.
1883 A new sparse keymap is stored as COMMAND's function definition and its value.
1884 If a second optional argument MAPVAR is given, the map is stored as
1885 its value instead of as COMMAND's value; but COMMAND is still defined
1886 as a function.
1887 The third optional argument NAME, if given, supplies a menu name
1888 string for the map.  This is required to use the keymap as a menu.
1889 This function returns COMMAND.  */)
1890      (command, mapvar, name)
1891      Lisp_Object command, mapvar, name;
1892 {
1893   Lisp_Object map;
1894   map = Fmake_sparse_keymap (name);
1895   Ffset (command, map);
1896   if (!NILP (mapvar))
1897     Fset (mapvar, map);
1898   else
1899     Fset (command, map);
1900   return command;
1901 }
1902
1903 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1904        doc: /* Select KEYMAP as the global keymap.  */)
1905      (keymap)
1906      Lisp_Object keymap;
1907 {
1908   keymap = get_keymap (keymap, 1, 1);
1909   current_global_map = keymap;
1910
1911   return Qnil;
1912 }
1913
1914 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1915        doc: /* Select KEYMAP as the local keymap.
1916 If KEYMAP is nil, that means no local keymap.  */)
1917      (keymap)
1918      Lisp_Object keymap;
1919 {
1920   if (!NILP (keymap))
1921     keymap = get_keymap (keymap, 1, 1);
1922
1923   current_buffer->keymap = keymap;
1924
1925   return Qnil;
1926 }
1927
1928 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1929        doc: /* Return current buffer's local keymap, or nil if it has none.  */)
1930      ()
1931 {
1932   return current_buffer->keymap;
1933 }
1934
1935 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1936        doc: /* Return the current global keymap.  */)
1937      ()
1938 {
1939   return current_global_map;
1940 }
1941
1942 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1943        doc: /* Return a list of keymaps for the minor modes of the current buffer.  */)
1944      ()
1945 {
1946   Lisp_Object *maps;
1947   int nmaps = current_minor_maps (0, &maps);
1948
1949   return Flist (nmaps, maps);
1950 }
1951 \f
1952 /* Help functions for describing and documenting keymaps.               */
1953
1954
1955 static void
1956 accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
1957      Lisp_Object maps, tail, thisseq, key, cmd;
1958      int is_metized;            /* If 1, `key' is assumed to be INTEGERP.  */
1959 {
1960   Lisp_Object tem;
1961
1962   cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
1963   if (NILP (cmd))
1964     return;
1965
1966   /* Look for and break cycles.  */
1967   while (!NILP (tem = Frassq (cmd, maps)))
1968     {
1969       Lisp_Object prefix = XCAR (tem);
1970       int lim = XINT (Flength (XCAR (tem)));
1971       if (lim <= XINT (Flength (thisseq)))
1972         { /* This keymap was already seen with a smaller prefix.  */
1973           int i = 0;
1974           while (i < lim && EQ (Faref (prefix, make_number (i)),
1975                                 Faref (thisseq, make_number (i))))
1976             i++;
1977           if (i >= lim)
1978             /* `prefix' is a prefix of `thisseq' => there's a cycle.  */
1979             return;
1980         }
1981       /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1982          but maybe `cmd' occurs again further down in `maps', so keep
1983          looking.  */
1984       maps = XCDR (Fmemq (tem, maps));
1985     }
1986
1987   /* If the last key in thisseq is meta-prefix-char,
1988      turn it into a meta-ized keystroke.  We know
1989      that the event we're about to append is an
1990      ascii keystroke since we're processing a
1991      keymap table.  */
1992   if (is_metized)
1993     {
1994       int meta_bit = meta_modifier;
1995       Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
1996       tem = Fcopy_sequence (thisseq);
1997
1998       Faset (tem, last, make_number (XINT (key) | meta_bit));
1999
2000       /* This new sequence is the same length as
2001          thisseq, so stick it in the list right
2002          after this one.  */
2003       XSETCDR (tail,
2004                Fcons (Fcons (tem, cmd), XCDR (tail)));
2005     }
2006   else
2007     {
2008       tem = append_key (thisseq, key);
2009       nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2010     }
2011 }
2012
2013 static void
2014 accessible_keymaps_char_table (args, index, cmd)
2015      Lisp_Object args, index, cmd;
2016 {
2017   accessible_keymaps_1 (index, cmd,
2018                         XCAR (XCAR (args)),
2019                         XCAR (XCDR (args)),
2020                         XCDR (XCDR (args)),
2021                         XINT (XCDR (XCAR (args))));
2022 }
2023
2024 /* This function cannot GC.  */
2025
2026 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2027        1, 2, 0,
2028        doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2029 Returns a list of elements of the form (KEYS . MAP), where the sequence
2030 KEYS starting from KEYMAP gets you to MAP.  These elements are ordered
2031 so that the KEYS increase in length.  The first element is ([] . KEYMAP).
2032 An optional argument PREFIX, if non-nil, should be a key sequence;
2033 then the value includes only maps for prefixes that start with PREFIX.  */)
2034      (keymap, prefix)
2035      Lisp_Object keymap, prefix;
2036 {
2037   Lisp_Object maps, tail;
2038   int prefixlen = 0;
2039
2040   /* no need for gcpro because we don't autoload any keymaps.  */
2041
2042   if (!NILP (prefix))
2043     prefixlen = XINT (Flength (prefix));
2044
2045   if (!NILP (prefix))
2046     {
2047       /* If a prefix was specified, start with the keymap (if any) for
2048          that prefix, so we don't waste time considering other prefixes.  */
2049       Lisp_Object tem;
2050       tem = Flookup_key (keymap, prefix, Qt);
2051       /* Flookup_key may give us nil, or a number,
2052          if the prefix is not defined in this particular map.
2053          It might even give us a list that isn't a keymap.  */
2054       tem = get_keymap (tem, 0, 0);
2055       if (CONSP (tem))
2056         {
2057           /* Convert PREFIX to a vector now, so that later on
2058              we don't have to deal with the possibility of a string.  */
2059           if (STRINGP (prefix))
2060             {
2061               int i, i_byte, c;
2062               Lisp_Object copy;
2063
2064               copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2065               for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2066                 {
2067                   int i_before = i;
2068
2069                   FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2070                   if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2071                     c ^= 0200 | meta_modifier;
2072                   ASET (copy, i_before, make_number (c));
2073                 }
2074               prefix = copy;
2075             }
2076           maps = Fcons (Fcons (prefix, tem), Qnil);
2077         }
2078       else
2079         return Qnil;
2080     }
2081   else
2082     maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2083                          get_keymap (keymap, 1, 0)),
2084                   Qnil);
2085
2086   /* For each map in the list maps,
2087      look at any other maps it points to,
2088      and stick them at the end if they are not already in the list.
2089
2090      This is a breadth-first traversal, where tail is the queue of
2091      nodes, and maps accumulates a list of all nodes visited.  */
2092
2093   for (tail = maps; CONSP (tail); tail = XCDR (tail))
2094     {
2095       register Lisp_Object thisseq, thismap;
2096       Lisp_Object last;
2097       /* Does the current sequence end in the meta-prefix-char?  */
2098       int is_metized;
2099
2100       thisseq = Fcar (Fcar (tail));
2101       thismap = Fcdr (Fcar (tail));
2102       last = make_number (XINT (Flength (thisseq)) - 1);
2103       is_metized = (XINT (last) >= 0
2104                     /* Don't metize the last char of PREFIX.  */
2105                     && XINT (last) >= prefixlen
2106                     && EQ (Faref (thisseq, last), meta_prefix_char));
2107
2108       for (; CONSP (thismap); thismap = XCDR (thismap))
2109         {
2110           Lisp_Object elt;
2111
2112           elt = XCAR (thismap);
2113
2114           QUIT;
2115
2116           if (CHAR_TABLE_P (elt))
2117             {
2118               Lisp_Object indices[3];
2119
2120               map_char_table (accessible_keymaps_char_table, Qnil, elt,
2121                               elt, Fcons (Fcons (maps, make_number (is_metized)),
2122                                           Fcons (tail, thisseq)),
2123                               0, indices);
2124             }
2125           else if (VECTORP (elt))
2126             {
2127               register int i;
2128
2129               /* Vector keymap.  Scan all the elements.  */
2130               for (i = 0; i < ASIZE (elt); i++)
2131                 accessible_keymaps_1 (make_number (i), AREF (elt, i),
2132                                       maps, tail, thisseq, is_metized);
2133
2134             }
2135           else if (CONSP (elt))
2136             accessible_keymaps_1 (XCAR (elt), XCDR (elt),
2137                                   maps, tail, thisseq,
2138                                   is_metized && INTEGERP (XCAR (elt)));
2139
2140         }
2141     }
2142
2143   return maps;
2144 }
2145 \f
2146 Lisp_Object Qsingle_key_description, Qkey_description;
2147
2148 /* This function cannot GC.  */
2149
2150 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2151        doc: /* Return a pretty description of key-sequence KEYS.
2152 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2153 Control characters turn into "C-foo" sequences, meta into "M-foo",
2154 spaces are put between sequence elements, etc.  */)
2155   (keys, prefix)
2156      Lisp_Object keys, prefix;
2157 {
2158   int len = 0;
2159   int i, i_byte;
2160   Lisp_Object *args;
2161   int size = XINT (Flength (keys));
2162   Lisp_Object list;
2163   Lisp_Object sep = build_string (" ");
2164   Lisp_Object key;
2165   int add_meta = 0;
2166
2167   if (!NILP (prefix))
2168     size += XINT (Flength (prefix));
2169
2170   /* This has one extra element at the end that we don't pass to Fconcat.  */
2171   args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2172
2173   /* In effect, this computes
2174      (mapconcat 'single-key-description keys " ")
2175      but we shouldn't use mapconcat because it can do GC.  */
2176
2177  next_list:
2178   if (!NILP (prefix))
2179     list = prefix, prefix = Qnil;
2180   else if (!NILP (keys))
2181     list = keys, keys = Qnil;
2182   else
2183     {
2184       if (add_meta)
2185         {
2186           args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2187           len += 2;
2188         }
2189       else if (len == 0)
2190         return empty_string;
2191       return Fconcat (len - 1, args);
2192     }
2193
2194   if (STRINGP (list))
2195     size = SCHARS (list);
2196   else if (VECTORP (list))
2197     size = XVECTOR (list)->size;
2198   else if (CONSP (list))
2199     size = XINT (Flength (list));
2200   else
2201     wrong_type_argument (Qarrayp, list);
2202
2203   i = i_byte = 0;
2204
2205   while (i < size)
2206     {
2207       if (STRINGP (list))
2208         {
2209           int c;
2210           FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2211           if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2212             c ^= 0200 | meta_modifier;
2213           XSETFASTINT (key, c);
2214         }
2215       else if (VECTORP (list))
2216         {
2217           key = AREF (list, i++);
2218         }
2219       else
2220         {
2221           key = XCAR (list);
2222           list = XCDR (list);
2223           i++;
2224         }
2225
2226       if (add_meta)
2227         {
2228           if (!INTEGERP (key)
2229               || EQ (key, meta_prefix_char)
2230               || (XINT (key) & meta_modifier))
2231             {
2232               args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2233               args[len++] = sep;
2234               if (EQ (key, meta_prefix_char))
2235                 continue;
2236             }
2237           else
2238             XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2239           add_meta = 0;
2240         }
2241       else if (EQ (key, meta_prefix_char))
2242         {
2243           add_meta = 1;
2244           continue;
2245         }
2246       args[len++] = Fsingle_key_description (key, Qnil);
2247       args[len++] = sep;
2248     }
2249   goto next_list;
2250 }
2251
2252
2253 char *
2254 push_key_description (c, p, force_multibyte)
2255      register unsigned int c;
2256      register char *p;
2257      int force_multibyte;
2258 {
2259   unsigned c2;
2260   int valid_p;
2261
2262   /* Clear all the meaningless bits above the meta bit.  */
2263   c &= meta_modifier | ~ - meta_modifier;
2264   c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2265              | meta_modifier | shift_modifier | super_modifier);
2266
2267   valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0);
2268   if (! valid_p)
2269     {
2270       /* KEY_DESCRIPTION_SIZE is large enough for this.  */
2271       p += sprintf (p, "[%d]", c);
2272       return p;
2273     }
2274
2275   if (c & alt_modifier)
2276     {
2277       *p++ = 'A';
2278       *p++ = '-';
2279       c -= alt_modifier;
2280     }
2281   if ((c & ctrl_modifier) != 0
2282       || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2283     {
2284       *p++ = 'C';
2285       *p++ = '-';
2286       c &= ~ctrl_modifier;
2287     }
2288   if (c & hyper_modifier)
2289     {
2290       *p++ = 'H';
2291       *p++ = '-';
2292       c -= hyper_modifier;
2293     }
2294   if (c & meta_modifier)
2295     {
2296       *p++ = 'M';
2297       *p++ = '-';
2298       c -= meta_modifier;
2299     }
2300   if (c & shift_modifier)
2301     {
2302       *p++ = 'S';
2303       *p++ = '-';
2304       c -= shift_modifier;
2305     }
2306   if (c & super_modifier)
2307     {
2308       *p++ = 's';
2309       *p++ = '-';
2310       c -= super_modifier;
2311     }
2312   if (c < 040)
2313     {
2314       if (c == 033)
2315         {
2316           *p++ = 'E';
2317           *p++ = 'S';
2318           *p++ = 'C';
2319         }
2320       else if (c == '\t')
2321         {
2322           *p++ = 'T';
2323           *p++ = 'A';
2324           *p++ = 'B';
2325         }
2326       else if (c == Ctl ('M'))
2327         {
2328           *p++ = 'R';
2329           *p++ = 'E';
2330           *p++ = 'T';
2331         }
2332       else
2333         {
2334           /* `C-' already added above.  */
2335           if (c > 0 && c <= Ctl ('Z'))
2336             *p++ = c + 0140;
2337           else
2338             *p++ = c + 0100;
2339         }
2340     }
2341   else if (c == 0177)
2342     {
2343       *p++ = 'D';
2344       *p++ = 'E';
2345       *p++ = 'L';
2346     }
2347   else if (c == ' ')
2348    {
2349       *p++ = 'S';
2350       *p++ = 'P';
2351       *p++ = 'C';
2352     }
2353   else if (c < 128
2354            || (NILP (current_buffer->enable_multibyte_characters)
2355                && SINGLE_BYTE_CHAR_P (c)
2356                && !force_multibyte))
2357     {
2358       *p++ = c;
2359     }
2360   else
2361     {
2362       if (force_multibyte)
2363         {
2364           if (SINGLE_BYTE_CHAR_P (c))
2365             c = unibyte_char_to_multibyte (c);
2366           p += CHAR_STRING (c, p);
2367         }
2368       else if (NILP (current_buffer->enable_multibyte_characters))
2369         {
2370           int bit_offset;
2371           *p++ = '\\';
2372           /* The biggest character code uses 19 bits.  */
2373           for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
2374             {
2375               if (c >= (1 << bit_offset))
2376                 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
2377             }
2378         }
2379       else
2380         p += CHAR_STRING (c, p);
2381     }
2382
2383   return p;
2384 }
2385
2386 /* This function cannot GC.  */
2387
2388 DEFUN ("single-key-description", Fsingle_key_description,
2389        Ssingle_key_description, 1, 2, 0,
2390        doc: /* Return a pretty description of command character KEY.
2391 Control characters turn into C-whatever, etc.
2392 Optional argument NO-ANGLES non-nil means don't put angle brackets
2393 around function keys and event symbols.  */)
2394      (key, no_angles)
2395      Lisp_Object key, no_angles;
2396 {
2397   if (CONSP (key) && lucid_event_type_list_p (key))
2398     key = Fevent_convert_list (key);
2399
2400   key = EVENT_HEAD (key);
2401
2402   if (INTEGERP (key))           /* Normal character */
2403     {
2404       unsigned int charset, c1, c2;
2405       int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
2406
2407       if (SINGLE_BYTE_CHAR_P (without_bits))
2408         charset = 0;
2409       else
2410         SPLIT_CHAR (without_bits, charset, c1, c2);
2411
2412       if (! CHAR_VALID_P (without_bits, 1))
2413         {
2414           char buf[256];
2415
2416           sprintf (buf, "Invalid char code %d", XINT (key));
2417           return build_string (buf);
2418         }
2419       else if (charset
2420                && ((c1 == 0 && c2 == -1) || c2 == 0))
2421         {
2422           /* Handle a generic character.  */
2423           Lisp_Object name;
2424           char buf[256];
2425
2426           name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
2427           CHECK_STRING (name);
2428           if (c1 == 0)
2429             /* Only a charset is specified.   */
2430             sprintf (buf, "Generic char %d: all of ", without_bits);
2431           else
2432             /* 1st code-point of 2-dimensional charset is specified.   */
2433             sprintf (buf, "Generic char %d: row %d of ", without_bits, c1);
2434           return concat2 (build_string (buf), name);
2435         }
2436       else
2437         {
2438           char tem[KEY_DESCRIPTION_SIZE], *end;
2439           int nbytes, nchars;
2440           Lisp_Object string;
2441
2442           end = push_key_description (XUINT (key), tem, 1);
2443           nbytes = end - tem;
2444           nchars = multibyte_chars_in_text (tem, nbytes);
2445           if (nchars == nbytes)
2446             {
2447               *end = '\0';
2448               string = build_string (tem);
2449             }
2450           else
2451             string = make_multibyte_string (tem, nchars, nbytes);
2452           return string;
2453         }
2454     }
2455   else if (SYMBOLP (key))       /* Function key or event-symbol */
2456     {
2457       if (NILP (no_angles))
2458         {
2459           char *buffer
2460             = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2461           sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2462           return build_string (buffer);
2463         }
2464       else
2465         return Fsymbol_name (key);
2466     }
2467   else if (STRINGP (key))       /* Buffer names in the menubar.  */
2468     return Fcopy_sequence (key);
2469   else
2470     error ("KEY must be an integer, cons, symbol, or string");
2471   return Qnil;
2472 }
2473
2474 char *
2475 push_text_char_description (c, p)
2476      register unsigned int c;
2477      register char *p;
2478 {
2479   if (c >= 0200)
2480     {
2481       *p++ = 'M';
2482       *p++ = '-';
2483       c -= 0200;
2484     }
2485   if (c < 040)
2486     {
2487       *p++ = '^';
2488       *p++ = c + 64;            /* 'A' - 1 */
2489     }
2490   else if (c == 0177)
2491     {
2492       *p++ = '^';
2493       *p++ = '?';
2494     }
2495   else
2496     *p++ = c;
2497   return p;
2498 }
2499
2500 /* This function cannot GC.  */
2501
2502 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2503        doc: /* Return a pretty description of file-character CHARACTER.
2504 Control characters turn into "^char", etc.  This differs from
2505 `single-key-description' which turns them into "C-char".
2506 Also, this function recognizes the 2**7 bit as the Meta character,
2507 whereas `single-key-description' uses the 2**27 bit for Meta.
2508 See Info node `(elisp)Describing Characters' for examples.  */)
2509      (character)
2510      Lisp_Object character;
2511 {
2512   /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6).  */
2513   unsigned char str[6];
2514   int c;
2515
2516   CHECK_NUMBER (character);
2517
2518   c = XINT (character);
2519   if (!SINGLE_BYTE_CHAR_P (c))
2520     {
2521       int len = CHAR_STRING (c, str);
2522
2523       return make_multibyte_string (str, 1, len);
2524     }
2525
2526   *push_text_char_description (c & 0377, str) = 0;
2527
2528   return build_string (str);
2529 }
2530
2531 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2532    a meta bit.  */
2533 static int
2534 ascii_sequence_p (seq)
2535      Lisp_Object seq;
2536 {
2537   int i;
2538   int len = XINT (Flength (seq));
2539
2540   for (i = 0; i < len; i++)
2541     {
2542       Lisp_Object ii, elt;
2543
2544       XSETFASTINT (ii, i);
2545       elt = Faref (seq, ii);
2546
2547       if (!INTEGERP (elt)
2548           || (XUINT (elt) & ~CHAR_META) >= 0x80)
2549         return 0;
2550     }
2551
2552   return 1;
2553 }
2554
2555 \f
2556 /* where-is - finding a command in a set of keymaps.                    */
2557
2558 static Lisp_Object where_is_internal ();
2559 static Lisp_Object where_is_internal_1 ();
2560 static void where_is_internal_2 ();
2561
2562 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2563    Returns the first non-nil binding found in any of those maps.  */
2564
2565 static Lisp_Object
2566 shadow_lookup (shadow, key, flag)
2567      Lisp_Object shadow, key, flag;
2568 {
2569   Lisp_Object tail, value;
2570
2571   for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2572     {
2573       value = Flookup_key (XCAR (tail), key, flag);
2574       if (NATNUMP (value))
2575         {
2576           value = Flookup_key (XCAR (tail),
2577                                Fsubstring (key, make_number (0), value), flag);
2578           if (!NILP (value))
2579             return Qnil;
2580         }
2581       else if (!NILP (value))
2582         return value;
2583     }
2584   return Qnil;
2585 }
2586
2587 static Lisp_Object Vmouse_events;
2588
2589 /* This function can GC if Flookup_key autoloads any keymaps.  */
2590
2591 static Lisp_Object
2592 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2593      Lisp_Object definition, keymaps;
2594      Lisp_Object firstonly, noindirect, no_remap;
2595 {
2596   Lisp_Object maps = Qnil;
2597   Lisp_Object found, sequences;
2598   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2599   /* 1 means ignore all menu bindings entirely.  */
2600   int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2601
2602   found = keymaps;
2603   while (CONSP (found))
2604     {
2605       maps =
2606         nconc2 (maps,
2607                 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2608       found = XCDR (found);
2609     }
2610
2611   GCPRO5 (definition, keymaps, maps, found, sequences);
2612   found = Qnil;
2613   sequences = Qnil;
2614
2615   /* If this command is remapped, then it has no key bindings
2616      of its own.  */
2617   if (NILP (no_remap)
2618       && SYMBOLP (definition)
2619       && !NILP (Fcommand_remapping (definition, Qnil, keymaps)))
2620     RETURN_UNGCPRO (Qnil);
2621
2622   for (; !NILP (maps); maps = Fcdr (maps))
2623     {
2624       /* Key sequence to reach map, and the map that it reaches */
2625       register Lisp_Object this, map, tem;
2626
2627       /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2628          [M-CHAR] sequences, check if last character of the sequence
2629          is the meta-prefix char.  */
2630       Lisp_Object last;
2631       int last_is_meta;
2632
2633       this = Fcar (Fcar (maps));
2634       map  = Fcdr (Fcar (maps));
2635       last = make_number (XINT (Flength (this)) - 1);
2636       last_is_meta = (XINT (last) >= 0
2637                       && EQ (Faref (this, last), meta_prefix_char));
2638
2639       /* if (nomenus && !ascii_sequence_p (this)) */
2640       if (nomenus && XINT (last) >= 0
2641           && SYMBOLP (tem = Faref (this, make_number (0)))
2642           && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2643         /* If no menu entries should be returned, skip over the
2644            keymaps bound to `menu-bar' and `tool-bar' and other
2645            non-ascii prefixes like `C-down-mouse-2'.  */
2646         continue;
2647
2648       QUIT;
2649
2650       while (CONSP (map))
2651         {
2652           /* Because the code we want to run on each binding is rather
2653              large, we don't want to have two separate loop bodies for
2654              sparse keymap bindings and tables; we want to iterate one
2655              loop body over both keymap and vector bindings.
2656
2657              For this reason, if Fcar (map) is a vector, we don't
2658              advance map to the next element until i indicates that we
2659              have finished off the vector.  */
2660           Lisp_Object elt, key, binding;
2661           elt = XCAR (map);
2662           map = XCDR (map);
2663
2664           sequences = Qnil;
2665
2666           QUIT;
2667
2668           /* Set key and binding to the current key and binding, and
2669              advance map and i to the next binding.  */
2670           if (VECTORP (elt))
2671             {
2672               Lisp_Object sequence;
2673               int i;
2674               /* In a vector, look at each element.  */
2675               for (i = 0; i < XVECTOR (elt)->size; i++)
2676                 {
2677                   binding = AREF (elt, i);
2678                   XSETFASTINT (key, i);
2679                   sequence = where_is_internal_1 (binding, key, definition,
2680                                                   noindirect, this,
2681                                                   last, nomenus, last_is_meta);
2682                   if (!NILP (sequence))
2683                     sequences = Fcons (sequence, sequences);
2684                 }
2685             }
2686           else if (CHAR_TABLE_P (elt))
2687             {
2688               Lisp_Object indices[3];
2689               Lisp_Object args;
2690
2691               args = Fcons (Fcons (Fcons (definition, noindirect),
2692                                    Qnil), /* Result accumulator.  */
2693                             Fcons (Fcons (this, last),
2694                                    Fcons (make_number (nomenus),
2695                                           make_number (last_is_meta))));
2696               map_char_table (where_is_internal_2, Qnil, elt, elt, args,
2697                               0, indices);
2698               sequences = XCDR (XCAR (args));
2699             }
2700           else if (CONSP (elt))
2701             {
2702               Lisp_Object sequence;
2703
2704               key = XCAR (elt);
2705               binding = XCDR (elt);
2706
2707               sequence = where_is_internal_1 (binding, key, definition,
2708                                               noindirect, this,
2709                                               last, nomenus, last_is_meta);
2710               if (!NILP (sequence))
2711                 sequences = Fcons (sequence, sequences);
2712             }
2713
2714
2715           while (!NILP (sequences))
2716             {
2717               Lisp_Object sequence, remapped, function;
2718
2719               sequence = XCAR (sequences);
2720               sequences = XCDR (sequences);
2721
2722               /* If the current sequence is a command remapping with
2723                  format [remap COMMAND], find the key sequences
2724                  which run COMMAND, and use those sequences instead.  */
2725               remapped = Qnil;
2726               if (NILP (no_remap)
2727                   && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2728                   && EQ (AREF (sequence, 0), Qremap)
2729                   && (function = AREF (sequence, 1), SYMBOLP (function)))
2730                 {
2731                   Lisp_Object remapped1;
2732
2733                   remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2734                   if (CONSP (remapped1))
2735                     {
2736                       /* Verify that this key binding actually maps to the
2737                          remapped command (see below).  */
2738                       if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2739                         continue;
2740                       sequence = XCAR (remapped1);
2741                       remapped = XCDR (remapped1);
2742                       goto record_sequence;
2743                     }
2744                 }
2745
2746               /* Verify that this key binding is not shadowed by another
2747                  binding for the same key, before we say it exists.
2748
2749                  Mechanism: look for local definition of this key and if
2750                  it is defined and does not match what we found then
2751                  ignore this key.
2752
2753                  Either nil or number as value from Flookup_key
2754                  means undefined.  */
2755               if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2756                 continue;
2757
2758             record_sequence:
2759               /* Don't annoy user with strings from a menu such as
2760                  Select Paste.  Change them all to "(any string)",
2761                  so that there seems to be only one menu item
2762                  to report. */
2763               if (! NILP (sequence))
2764                 {
2765                   Lisp_Object tem;
2766                   tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2767                   if (STRINGP (tem))
2768                     Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2769                            build_string ("(any string)"));
2770                 }
2771
2772               /* It is a true unshadowed match.  Record it, unless it's already
2773                  been seen (as could happen when inheriting keymaps).  */
2774               if (NILP (Fmember (sequence, found)))
2775                 found = Fcons (sequence, found);
2776
2777               /* If firstonly is Qnon_ascii, then we can return the first
2778                  binding we find.  If firstonly is not Qnon_ascii but not
2779                  nil, then we should return the first ascii-only binding
2780                  we find.  */
2781               if (EQ (firstonly, Qnon_ascii))
2782                 RETURN_UNGCPRO (sequence);
2783               else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2784                 RETURN_UNGCPRO (sequence);
2785
2786               if (CONSP (remapped))
2787                 {
2788                   sequence = XCAR (remapped);
2789                   remapped = XCDR (remapped);
2790                   goto record_sequence;
2791                 }
2792             }
2793         }
2794     }
2795
2796   UNGCPRO;
2797
2798   found = Fnreverse (found);
2799
2800   /* firstonly may have been t, but we may have gone all the way through
2801      the keymaps without finding an all-ASCII key sequence.  So just
2802      return the best we could find.  */
2803   if (!NILP (firstonly))
2804     return Fcar (found);
2805
2806   return found;
2807 }
2808
2809 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2810        doc: /* Return list of keys that invoke DEFINITION.
2811 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2812 If KEYMAP is nil, search all the currently active keymaps.
2813 If KEYMAP is a list of keymaps, search only those keymaps.
2814
2815 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2816 rather than a list of all possible key sequences.
2817 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2818 no matter what it is.
2819 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2820 \(or their meta variants) and entirely reject menu bindings.
2821
2822 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2823 to other keymaps or slots.  This makes it possible to search for an
2824 indirect definition itself.
2825
2826 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2827 that invoke a command which is remapped to DEFINITION, but include the
2828 remapped command in the returned list.  */)
2829      (definition, keymap, firstonly, noindirect, no_remap)
2830      Lisp_Object definition, keymap;
2831      Lisp_Object firstonly, noindirect, no_remap;
2832 {
2833   Lisp_Object sequences, keymaps;
2834   /* 1 means ignore all menu bindings entirely.  */
2835   int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2836   Lisp_Object result;
2837
2838   /* Find the relevant keymaps.  */
2839   if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2840     keymaps = keymap;
2841   else if (!NILP (keymap))
2842     keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2843   else
2844     keymaps = Fcurrent_active_maps (Qnil);
2845
2846   /* Only use caching for the menubar (i.e. called with (def nil t nil).
2847      We don't really need to check `keymap'.  */
2848   if (nomenus && NILP (noindirect) && NILP (keymap))
2849     {
2850       Lisp_Object *defns;
2851       int i, j, n;
2852       struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2853
2854       /* Check heuristic-consistency of the cache.  */
2855       if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2856         where_is_cache = Qnil;
2857
2858       if (NILP (where_is_cache))
2859         {
2860           /* We need to create the cache.  */
2861           Lisp_Object args[2];
2862           where_is_cache = Fmake_hash_table (0, args);
2863           where_is_cache_keymaps = Qt;
2864
2865           /* Fill in the cache.  */
2866           GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2867           where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2868           UNGCPRO;
2869
2870           where_is_cache_keymaps = keymaps;
2871         }
2872
2873       /* We want to process definitions from the last to the first.
2874          Instead of consing, copy definitions to a vector and step
2875          over that vector.  */
2876       sequences = Fgethash (definition, where_is_cache, Qnil);
2877       n = XINT (Flength (sequences));
2878       defns = (Lisp_Object *) alloca (n * sizeof *defns);
2879       for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2880         defns[i++] = XCAR (sequences);
2881
2882       /* Verify that the key bindings are not shadowed.  Note that
2883          the following can GC.  */
2884       GCPRO2 (definition, keymaps);
2885       result = Qnil;
2886       j = -1;
2887       for (i = n - 1; i >= 0; --i)
2888         if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2889           {
2890             if (ascii_sequence_p (defns[i]))
2891               break;
2892             else if (j < 0)
2893               j = i;
2894           }
2895
2896       result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
2897       UNGCPRO;
2898     }
2899   else
2900     {
2901       /* Kill the cache so that where_is_internal_1 doesn't think
2902          we're filling it up.  */
2903       where_is_cache = Qnil;
2904       result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2905     }
2906
2907   return result;
2908 }
2909
2910 /* This is the function that Fwhere_is_internal calls using map_char_table.
2911    ARGS has the form
2912    (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2913     .
2914     ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2915    Since map_char_table doesn't really use the return value from this function,
2916    we the result append to RESULT, the slot in ARGS.
2917
2918    This function can GC because it calls where_is_internal_1 which can
2919    GC.  */
2920
2921 static void
2922 where_is_internal_2 (args, key, binding)
2923      Lisp_Object args, key, binding;
2924 {
2925   Lisp_Object definition, noindirect, this, last;
2926   Lisp_Object result, sequence;
2927   int nomenus, last_is_meta;
2928   struct gcpro gcpro1, gcpro2, gcpro3;
2929
2930   GCPRO3 (args, key, binding);
2931   result = XCDR (XCAR (args));
2932   definition = XCAR (XCAR (XCAR (args)));
2933   noindirect = XCDR (XCAR (XCAR (args)));
2934   this = XCAR (XCAR (XCDR (args)));
2935   last = XCDR (XCAR (XCDR (args)));
2936   nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2937   last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2938
2939   sequence = where_is_internal_1 (binding, key, definition, noindirect,
2940                                   this, last, nomenus, last_is_meta);
2941
2942   if (!NILP (sequence))
2943     XSETCDR (XCAR (args), Fcons (sequence, result));
2944
2945   UNGCPRO;
2946 }
2947
2948
2949 /* This function can GC because get_keyelt can.  */
2950
2951 static Lisp_Object
2952 where_is_internal_1 (binding, key, definition, noindirect, this, last,
2953                      nomenus, last_is_meta)
2954      Lisp_Object binding, key, definition, noindirect, this, last;
2955      int nomenus, last_is_meta;
2956 {
2957   Lisp_Object sequence;
2958
2959   /* Search through indirections unless that's not wanted.  */
2960   if (NILP (noindirect))
2961     binding = get_keyelt (binding, 0);
2962
2963   /* End this iteration if this element does not match
2964      the target.  */
2965
2966   if (!(!NILP (where_is_cache)  /* everything "matches" during cache-fill.  */
2967         || EQ (binding, definition)
2968         || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2969     /* Doesn't match.  */
2970     return Qnil;
2971
2972   /* We have found a match.  Construct the key sequence where we found it.  */
2973   if (INTEGERP (key) && last_is_meta)
2974     {
2975       sequence = Fcopy_sequence (this);
2976       Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2977     }
2978   else
2979     sequence = append_key (this, key);
2980
2981   if (!NILP (where_is_cache))
2982     {
2983       Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2984       Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2985       return Qnil;
2986     }
2987   else
2988     return sequence;
2989 }
2990 \f
2991 /* describe-bindings - summarizing all the bindings in a set of keymaps.  */
2992
2993 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2994        doc: /* Insert the list of all defined keys and their definitions.
2995 The list is inserted in the current buffer, while the bindings are
2996 looked up in BUFFER.
2997 The optional argument PREFIX, if non-nil, should be a key sequence;
2998 then we display only bindings that start with that prefix.
2999 The optional argument MENUS, if non-nil, says to mention menu bindings.
3000 \(Ordinarily these are omitted from the output.)  */)
3001      (buffer, prefix, menus)
3002      Lisp_Object buffer, prefix, menus;
3003 {
3004   Lisp_Object outbuf, shadow;
3005   int nomenu = NILP (menus);
3006   register Lisp_Object start1;
3007   struct gcpro gcpro1;
3008
3009   char *alternate_heading
3010     = "\
3011 Keyboard translations:\n\n\
3012 You type        Translation\n\
3013 --------        -----------\n";
3014
3015   CHECK_BUFFER (buffer);
3016
3017   shadow = Qnil;
3018   GCPRO1 (shadow);
3019
3020   outbuf = Fcurrent_buffer ();
3021
3022   /* Report on alternates for keys.  */
3023   if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
3024     {
3025       int c;
3026       const unsigned char *translate = SDATA (Vkeyboard_translate_table);
3027       int translate_len = SCHARS (Vkeyboard_translate_table);
3028
3029       for (c = 0; c < translate_len; c++)
3030         if (translate[c] != c)
3031           {
3032             char buf[KEY_DESCRIPTION_SIZE];
3033             char *bufend;
3034
3035             if (alternate_heading)
3036               {
3037                 insert_string (alternate_heading);
3038                 alternate_heading = 0;
3039               }
3040
3041             bufend = push_key_description (translate[c], buf, 1);
3042             insert (buf, bufend - buf);
3043             Findent_to (make_number (16), make_number (1));
3044             bufend = push_key_description (c, buf, 1);
3045             insert (buf, bufend - buf);
3046
3047             insert ("\n", 1);
3048
3049             /* Insert calls signal_after_change which may GC. */
3050             translate = SDATA (Vkeyboard_translate_table);
3051           }
3052
3053       insert ("\n", 1);
3054     }
3055
3056   if (!NILP (Vkey_translation_map))
3057     describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3058                        "Key translations", nomenu, 1, 0, 0);
3059
3060
3061   /* Print the (major mode) local map.  */
3062   start1 = Qnil;
3063   if (!NILP (current_kboard->Voverriding_terminal_local_map))
3064     start1 = current_kboard->Voverriding_terminal_local_map;
3065   else if (!NILP (Voverriding_local_map))
3066     start1 = Voverriding_local_map;
3067
3068   if (!NILP (start1))
3069     {
3070       describe_map_tree (start1, 1, shadow, prefix,
3071                          "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3072       shadow = Fcons (start1, shadow);
3073     }
3074   else
3075     {
3076       /* Print the minor mode and major mode keymaps.  */
3077       int i, nmaps;
3078       Lisp_Object *modes, *maps;
3079
3080       /* Temporarily switch to `buffer', so that we can get that buffer's
3081          minor modes correctly.  */
3082       Fset_buffer (buffer);
3083
3084       nmaps = current_minor_maps (&modes, &maps);
3085       Fset_buffer (outbuf);
3086
3087       start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3088                               XBUFFER (buffer), Qkeymap);
3089       if (!NILP (start1))
3090         {
3091           describe_map_tree (start1, 1, shadow, prefix,
3092                              "\f\n`keymap' Property Bindings", nomenu,
3093                              0, 0, 0);
3094           shadow = Fcons (start1, shadow);
3095         }
3096
3097       /* Print the minor mode maps.  */
3098       for (i = 0; i < nmaps; i++)
3099         {
3100           /* The title for a minor mode keymap
3101              is constructed at run time.
3102              We let describe_map_tree do the actual insertion
3103              because it takes care of other features when doing so.  */
3104           char *title, *p;
3105
3106           if (!SYMBOLP (modes[i]))
3107             abort();
3108
3109           p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3110           *p++ = '\f';
3111           *p++ = '\n';
3112           *p++ = '`';
3113           bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3114                  SCHARS (SYMBOL_NAME (modes[i])));
3115           p += SCHARS (SYMBOL_NAME (modes[i]));
3116           *p++ = '\'';
3117           bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3118           p += sizeof (" Minor Mode Bindings") - 1;
3119           *p = 0;
3120
3121           describe_map_tree (maps[i], 1, shadow, prefix,
3122                              title, nomenu, 0, 0, 0);
3123           shadow = Fcons (maps[i], shadow);
3124         }
3125
3126       start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3127                               XBUFFER (buffer), Qlocal_map);
3128       if (!NILP (start1))
3129         {
3130           if (EQ (start1, XBUFFER (buffer)->keymap))
3131             describe_map_tree (start1, 1, shadow, prefix,
3132                                "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3133           else
3134             describe_map_tree (start1, 1, shadow, prefix,
3135                                "\f\n`local-map' Property Bindings",
3136                                nomenu, 0, 0, 0);
3137
3138           shadow = Fcons (start1, shadow);
3139         }
3140     }
3141
3142   describe_map_tree (current_global_map, 1, shadow, prefix,
3143                      "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3144
3145   /* Print the function-key-map translations under this prefix.  */
3146   if (!NILP (Vfunction_key_map))
3147     describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
3148                        "\f\nFunction key map translations", nomenu, 1, 0, 0);
3149
3150   UNGCPRO;
3151   return Qnil;
3152 }
3153
3154 /* Insert a description of the key bindings in STARTMAP,
3155     followed by those of all maps reachable through STARTMAP.
3156    If PARTIAL is nonzero, omit certain "uninteresting" commands
3157     (such as `undefined').
3158    If SHADOW is non-nil, it is a list of maps;
3159     don't mention keys which would be shadowed by any of them.
3160    PREFIX, if non-nil, says mention only keys that start with PREFIX.
3161    TITLE, if not 0, is a string to insert at the beginning.
3162    TITLE should not end with a colon or a newline; we supply that.
3163    If NOMENU is not 0, then omit menu-bar commands.
3164
3165    If TRANSL is nonzero, the definitions are actually key translations
3166    so print strings and vectors differently.
3167
3168    If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3169    to look through.
3170
3171    If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3172    don't omit it; instead, mention it but say it is shadowed.  */
3173
3174 void
3175 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3176                    always_title, mention_shadow)
3177      Lisp_Object startmap, shadow, prefix;
3178      int partial;
3179      char *title;
3180      int nomenu;
3181      int transl;
3182      int always_title;
3183      int mention_shadow;
3184 {
3185   Lisp_Object maps, orig_maps, seen, sub_shadows;
3186   struct gcpro gcpro1, gcpro2, gcpro3;
3187   int something = 0;
3188   char *key_heading
3189     = "\
3190 key             binding\n\
3191 ---             -------\n";
3192
3193   orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3194   seen = Qnil;
3195   sub_shadows = Qnil;
3196   GCPRO3 (maps, seen, sub_shadows);
3197
3198   if (nomenu)
3199     {
3200       Lisp_Object list;
3201
3202       /* Delete from MAPS each element that is for the menu bar.  */
3203       for (list = maps; !NILP (list); list = XCDR (list))
3204         {
3205           Lisp_Object elt, prefix, tem;
3206
3207           elt = Fcar (list);
3208           prefix = Fcar (elt);
3209           if (XVECTOR (prefix)->size >= 1)
3210             {
3211               tem = Faref (prefix, make_number (0));
3212               if (EQ (tem, Qmenu_bar))
3213                 maps = Fdelq (elt, maps);
3214             }
3215         }
3216     }
3217
3218   if (!NILP (maps) || always_title)
3219     {
3220       if (title)
3221         {
3222           insert_string (title);
3223           if (!NILP (prefix))
3224             {
3225               insert_string (" Starting With ");
3226               insert1 (Fkey_description (prefix, Qnil));
3227             }
3228           insert_string (":\n");
3229         }
3230       insert_string (key_heading);
3231       something = 1;
3232     }
3233
3234   for (; !NILP (maps); maps = Fcdr (maps))
3235     {
3236       register Lisp_Object elt, prefix, tail;
3237
3238       elt = Fcar (maps);
3239       prefix = Fcar (elt);
3240
3241       sub_shadows = Qnil;
3242
3243       for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3244         {
3245           Lisp_Object shmap;
3246
3247           shmap = XCAR (tail);
3248
3249           /* If the sequence by which we reach this keymap is zero-length,
3250              then the shadow map for this keymap is just SHADOW.  */
3251           if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3252               || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3253             ;
3254           /* If the sequence by which we reach this keymap actually has
3255              some elements, then the sequence's definition in SHADOW is
3256              what we should use.  */
3257           else
3258             {
3259               shmap = Flookup_key (shmap, Fcar (elt), Qt);
3260               if (INTEGERP (shmap))
3261                 shmap = Qnil;
3262             }
3263
3264           /* If shmap is not nil and not a keymap,
3265              it completely shadows this map, so don't
3266              describe this map at all.  */
3267           if (!NILP (shmap) && !KEYMAPP (shmap))
3268             goto skip;
3269
3270           if (!NILP (shmap))
3271             sub_shadows = Fcons (shmap, sub_shadows);
3272         }
3273
3274       /* Maps we have already listed in this loop shadow this map.  */
3275       for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3276         {
3277           Lisp_Object tem;
3278           tem = Fequal (Fcar (XCAR (tail)), prefix);
3279           if (!NILP (tem))
3280             sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3281         }
3282
3283       describe_map (Fcdr (elt), prefix,
3284                     transl ? describe_translation : describe_command,
3285                     partial, sub_shadows, &seen, nomenu, mention_shadow);
3286
3287     skip: ;
3288     }
3289
3290   if (something)
3291     insert_string ("\n");
3292
3293   UNGCPRO;
3294 }
3295
3296 static int previous_description_column;
3297
3298 static void
3299 describe_command (definition, args)
3300      Lisp_Object definition, args;
3301 {
3302   register Lisp_Object tem1;
3303   int column = (int) current_column (); /* iftc */
3304   int description_column;
3305
3306   /* If column 16 is no good, go to col 32;
3307      but don't push beyond that--go to next line instead.  */
3308   if (column > 30)
3309     {
3310       insert_char ('\n');
3311       description_column = 32;
3312     }
3313   else if (column > 14 || (column > 10 && previous_description_column == 32))
3314     description_column = 32;
3315   else
3316     description_column = 16;
3317
3318   Findent_to (make_number (description_column), make_number (1));
3319   previous_description_column = description_column;
3320
3321   if (SYMBOLP (definition))
3322     {
3323       tem1 = SYMBOL_NAME (definition);
3324       insert1 (tem1);
3325       insert_string ("\n");
3326     }
3327   else if (STRINGP (definition) || VECTORP (definition))
3328     insert_string ("Keyboard Macro\n");
3329   else if (KEYMAPP (definition))
3330     insert_string ("Prefix Command\n");
3331   else
3332     insert_string ("??\n");
3333 }
3334
3335 static void
3336 describe_translation (definition, args)
3337      Lisp_Object definition, args;
3338 {
3339   register Lisp_Object tem1;
3340
3341   Findent_to (make_number (16), make_number (1));
3342
3343   if (SYMBOLP (definition))
3344     {
3345       tem1 = SYMBOL_NAME (definition);
3346       insert1 (tem1);
3347       insert_string ("\n");
3348     }
3349   else if (STRINGP (definition) || VECTORP (definition))
3350     {
3351       insert1 (Fkey_description (definition, Qnil));
3352       insert_string ("\n");
3353     }
3354   else if (KEYMAPP (definition))
3355     insert_string ("Prefix Command\n");
3356   else
3357     insert_string ("??\n");
3358 }
3359
3360 /* describe_map puts all the usable elements of a sparse keymap
3361    into an array of `struct describe_map_elt',
3362    then sorts them by the events.  */
3363
3364 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3365
3366 /* qsort comparison function for sorting `struct describe_map_elt' by
3367    the event field.  */
3368
3369 static int
3370 describe_map_compare (aa, bb)
3371      const void *aa, *bb;
3372 {
3373   const struct describe_map_elt *a = aa, *b = bb;
3374   if (INTEGERP (a->event) && INTEGERP (b->event))
3375     return ((XINT (a->event) > XINT (b->event))
3376             - (XINT (a->event) < XINT (b->event)));
3377   if (!INTEGERP (a->event) && INTEGERP (b->event))
3378     return 1;
3379   if (INTEGERP (a->event) && !INTEGERP (b->event))
3380     return -1;
3381   if (SYMBOLP (a->event) && SYMBOLP (b->event))
3382     return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3383             : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3384             : 0);
3385   return 0;
3386 }
3387
3388 /* Describe the contents of map MAP, assuming that this map itself is
3389    reached by the sequence of prefix keys PREFIX (a string or vector).
3390    PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above.  */
3391
3392 static void
3393 describe_map (map, prefix, elt_describer, partial, shadow,
3394               seen, nomenu, mention_shadow)
3395      register Lisp_Object map;
3396      Lisp_Object prefix;
3397      void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3398      int partial;
3399      Lisp_Object shadow;
3400      Lisp_Object *seen;
3401      int nomenu;
3402      int mention_shadow;
3403 {
3404   Lisp_Object tail, definition, event;
3405   Lisp_Object tem;
3406   Lisp_Object suppress;
3407   Lisp_Object kludge;
3408   int first = 1;
3409   struct gcpro gcpro1, gcpro2, gcpro3;
3410
3411   /* These accumulate the values from sparse keymap bindings,
3412      so we can sort them and handle them in order.  */
3413   int length_needed = 0;
3414   struct describe_map_elt *vect;
3415   int slots_used = 0;
3416   int i;
3417
3418   suppress = Qnil;
3419
3420   if (partial)
3421     suppress = intern ("suppress-keymap");
3422
3423   /* This vector gets used to present single keys to Flookup_key.  Since
3424      that is done once per keymap element, we don't want to cons up a
3425      fresh vector every time.  */
3426   kludge = Fmake_vector (make_number (1), Qnil);
3427   definition = Qnil;
3428
3429   for (tail = map; CONSP (tail); tail = XCDR (tail))
3430     length_needed++;
3431
3432   vect = ((struct describe_map_elt *)
3433           alloca (sizeof (struct describe_map_elt) * length_needed));
3434
3435   GCPRO3 (prefix, definition, kludge);
3436
3437   for (tail = map; CONSP (tail); tail = XCDR (tail))
3438     {
3439       QUIT;
3440
3441       if (VECTORP (XCAR (tail))
3442           || CHAR_TABLE_P (XCAR (tail)))
3443         describe_vector (XCAR (tail),
3444                          prefix, Qnil, elt_describer, partial, shadow, map,
3445                          (int *)0, 0, 1, mention_shadow);
3446       else if (CONSP (XCAR (tail)))
3447         {
3448           int this_shadowed = 0;
3449
3450           event = XCAR (XCAR (tail));
3451
3452           /* Ignore bindings whose "prefix" are not really valid events.
3453              (We get these in the frames and buffers menu.)  */
3454           if (!(SYMBOLP (event) || INTEGERP (event)))
3455             continue;
3456
3457           if (nomenu && EQ (event, Qmenu_bar))
3458             continue;
3459
3460           definition = get_keyelt (XCDR (XCAR (tail)), 0);
3461
3462           /* Don't show undefined commands or suppressed commands.  */
3463           if (NILP (definition)) continue;
3464           if (SYMBOLP (definition) && partial)
3465             {
3466               tem = Fget (definition, suppress);
3467               if (!NILP (tem))
3468                 continue;
3469             }
3470
3471           /* Don't show a command that isn't really visible
3472              because a local definition of the same key shadows it.  */
3473
3474           ASET (kludge, 0, event);
3475           if (!NILP (shadow))
3476             {
3477               tem = shadow_lookup (shadow, kludge, Qt);
3478               if (!NILP (tem))
3479                 {
3480                   /* If both bindings are keymaps, this key is a prefix key,
3481                      so don't say it is shadowed.  */
3482                   if (KEYMAPP (definition) && KEYMAPP (tem))
3483                     ;
3484                   /* Avoid generating duplicate entries if the
3485                      shadowed binding has the same definition.  */
3486                   else if (mention_shadow && !EQ (tem, definition))
3487                     this_shadowed = 1;
3488                   else
3489                     continue;
3490                 }
3491             }
3492
3493           tem = Flookup_key (map, kludge, Qt);
3494           if (!EQ (tem, definition)) continue;
3495
3496           vect[slots_used].event = event;
3497           vect[slots_used].definition = definition;
3498           vect[slots_used].shadowed = this_shadowed;
3499           slots_used++;
3500         }
3501       else if (EQ (XCAR (tail), Qkeymap))
3502         {
3503           /* The same keymap might be in the structure twice, if we're
3504              using an inherited keymap.  So skip anything we've already
3505              encountered.  */
3506           tem = Fassq (tail, *seen);
3507           if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3508             break;
3509           *seen = Fcons (Fcons (tail, prefix), *seen);
3510         }
3511     }
3512
3513   /* If we found some sparse map events, sort them.  */
3514
3515   qsort (vect, slots_used, sizeof (struct describe_map_elt),
3516          describe_map_compare);
3517
3518   /* Now output them in sorted order.  */
3519
3520   for (i = 0; i < slots_used; i++)
3521     {
3522       Lisp_Object start, end;
3523
3524       if (first)
3525         {
3526           previous_description_column = 0;
3527           insert ("\n", 1);
3528           first = 0;
3529         }
3530
3531       ASET (kludge, 0, vect[i].event);
3532       start = vect[i].event;
3533       end = start;
3534
3535       definition = vect[i].definition;
3536
3537       /* Find consecutive chars that are identically defined.  */
3538       if (INTEGERP (vect[i].event))
3539         {
3540           while (i + 1 < slots_used
3541                  && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3542                  && !NILP (Fequal (vect[i + 1].definition, definition))
3543                  && vect[i].shadowed == vect[i + 1].shadowed)
3544             i++;
3545           end = vect[i].event;
3546         }
3547
3548       /* Now START .. END is the range to describe next.  */
3549
3550       /* Insert the string to describe the event START.  */
3551       insert1 (Fkey_description (kludge, prefix));
3552
3553       if (!EQ (start, end))
3554         {
3555           insert (" .. ", 4);
3556
3557           ASET (kludge, 0, end);
3558           /* Insert the string to describe the character END.  */
3559           insert1 (Fkey_description (kludge, prefix));
3560         }
3561
3562       /* Print a description of the definition of this character.
3563          elt_describer will take care of spacing out far enough
3564          for alignment purposes.  */
3565       (*elt_describer) (vect[i].definition, Qnil);
3566
3567       if (vect[i].shadowed)
3568         {
3569           SET_PT (PT - 1);
3570           insert_string ("\n  (that binding is currently shadowed by another mode)");
3571           SET_PT (PT + 1);
3572         }
3573     }
3574
3575   UNGCPRO;
3576 }
3577
3578 static void
3579 describe_vector_princ (elt, fun)
3580      Lisp_Object elt, fun;
3581 {
3582   Findent_to (make_number (16), make_number (1));
3583   call1 (fun, elt);
3584   Fterpri (Qnil);
3585 }
3586
3587 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3588        doc: /* Insert a description of contents of VECTOR.
3589 This is text showing the elements of vector matched against indices.
3590 DESCRIBER is the output function used; nil means use `princ'.  */)
3591      (vector, describer)
3592      Lisp_Object vector, describer;
3593 {
3594   int count = SPECPDL_INDEX ();
3595   if (NILP (describer))
3596     describer = intern ("princ");
3597   specbind (Qstandard_output, Fcurrent_buffer ());
3598   CHECK_VECTOR_OR_CHAR_TABLE (vector);
3599   describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3600                    Qnil, Qnil, (int *)0, 0, 0, 0);
3601
3602   return unbind_to (count, Qnil);
3603 }
3604
3605 /* Insert in the current buffer a description of the contents of VECTOR.
3606    We call ELT_DESCRIBER to insert the description of one value found
3607    in VECTOR.
3608
3609    ELT_PREFIX describes what "comes before" the keys or indices defined
3610    by this vector.  This is a human-readable string whose size
3611    is not necessarily related to the situation.
3612
3613    If the vector is in a keymap, ELT_PREFIX is a prefix key which
3614    leads to this keymap.
3615
3616    If the vector is a chartable, ELT_PREFIX is the vector
3617    of bytes that lead to the character set or portion of a character
3618    set described by this chartable.
3619
3620    If PARTIAL is nonzero, it means do not mention suppressed commands
3621    (that assumes the vector is in a keymap).
3622
3623    SHADOW is a list of keymaps that shadow this map.
3624    If it is non-nil, then we look up the key in those maps
3625    and we don't mention it now if it is defined by any of them.
3626
3627    ENTIRE_MAP is the keymap in which this vector appears.
3628    If the definition in effect in the whole map does not match
3629    the one in this vector, we ignore this one.
3630
3631    When describing a sub-char-table, INDICES is a list of
3632    indices at higher levels in this char-table,
3633    and CHAR_TABLE_DEPTH says how many levels down we have gone.
3634
3635    KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3636
3637    ARGS is simply passed as the second argument to ELT_DESCRIBER.  */
3638
3639 static void
3640 describe_vector (vector, prefix, args, elt_describer,
3641                  partial, shadow, entire_map,
3642                  indices, char_table_depth, keymap_p,
3643                  mention_shadow)
3644      register Lisp_Object vector;
3645      Lisp_Object prefix, args;
3646      void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3647      int partial;
3648      Lisp_Object shadow;
3649      Lisp_Object entire_map;
3650      int *indices;
3651      int char_table_depth;
3652      int keymap_p;
3653      int mention_shadow;
3654 {
3655   Lisp_Object definition;
3656   Lisp_Object tem2;
3657   Lisp_Object elt_prefix = Qnil;
3658   register int i;
3659   Lisp_Object suppress;
3660   Lisp_Object kludge;
3661   int first = 1;
3662   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3663   /* Range of elements to be handled.  */
3664   int from, to;
3665   /* A flag to tell if a leaf in this level of char-table is not a
3666      generic character (i.e. a complete multibyte character).  */
3667   int complete_char;
3668   int character;
3669   int starting_i;
3670
3671   suppress = Qnil;
3672
3673   if (indices == 0)
3674     indices = (int *) alloca (3 * sizeof (int));
3675
3676   definition = Qnil;
3677
3678   if (!keymap_p)
3679     {
3680       /* Call Fkey_description first, to avoid GC bug for the other string.  */
3681       if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3682         {
3683           Lisp_Object tem;
3684           tem = Fkey_description (prefix, Qnil);
3685           elt_prefix = concat2 (tem, build_string (" "));
3686         }
3687       prefix = Qnil;
3688     }
3689
3690   /* This vector gets used to present single keys to Flookup_key.  Since
3691      that is done once per vector element, we don't want to cons up a
3692      fresh vector every time.  */
3693   kludge = Fmake_vector (make_number (1), Qnil);
3694   GCPRO4 (elt_prefix, prefix, definition, kludge);
3695
3696   if (partial)
3697     suppress = intern ("suppress-keymap");
3698
3699   if (CHAR_TABLE_P (vector))
3700     {
3701       if (char_table_depth == 0)
3702         {
3703           /* VECTOR is a top level char-table.  */
3704           complete_char = 1;
3705           from = 0;
3706           to = CHAR_TABLE_ORDINARY_SLOTS;
3707         }
3708       else
3709         {
3710           /* VECTOR is a sub char-table.  */
3711           if (char_table_depth >= 3)
3712             /* A char-table is never that deep.  */
3713             error ("Too deep char table");
3714
3715           complete_char
3716             = (CHARSET_VALID_P (indices[0])
3717                && ((CHARSET_DIMENSION (indices[0]) == 1
3718                     && char_table_depth == 1)
3719                    || char_table_depth == 2));
3720
3721           /* Meaningful elements are from 32th to 127th.  */
3722           from = 32;
3723           to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3724         }
3725     }
3726   else
3727     {
3728       /* This does the right thing for ordinary vectors.  */
3729
3730       complete_char = 1;
3731       from = 0;
3732       to = XVECTOR (vector)->size;
3733     }
3734
3735   for (i = from; i < to; i++)
3736     {
3737       int this_shadowed = 0;
3738       QUIT;
3739
3740       if (CHAR_TABLE_P (vector))
3741         {
3742           if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3743             complete_char = 0;
3744
3745           if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3746               && !CHARSET_DEFINED_P (i - 128))
3747             continue;
3748
3749           definition
3750             = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3751         }
3752       else
3753         definition = get_keyelt (AREF (vector, i), 0);
3754
3755       if (NILP (definition)) continue;
3756
3757       /* Don't mention suppressed commands.  */
3758       if (SYMBOLP (definition) && partial)
3759         {
3760           Lisp_Object tem;
3761
3762           tem = Fget (definition, suppress);
3763
3764           if (!NILP (tem)) continue;
3765         }
3766
3767       /* Set CHARACTER to the character this entry describes, if any.
3768          Also update *INDICES.  */
3769       if (CHAR_TABLE_P (vector))
3770         {
3771           indices[char_table_depth] = i;
3772
3773           if (char_table_depth == 0)
3774             {
3775               character = i;
3776               indices[0] = i - 128;
3777             }
3778           else if (complete_char)
3779             {
3780               character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3781             }
3782           else
3783             character = 0;
3784         }
3785       else
3786         character = i;
3787
3788       ASET (kludge, 0, make_number (character));
3789
3790       /* If this binding is shadowed by some other map, ignore it.  */
3791       if (!NILP (shadow) && complete_char)
3792         {
3793           Lisp_Object tem;
3794
3795           tem = shadow_lookup (shadow, kludge, Qt);
3796
3797           if (!NILP (tem))
3798             {
3799               if (mention_shadow)
3800                 this_shadowed = 1;
3801               else
3802                 continue;
3803             }
3804         }
3805
3806       /* Ignore this definition if it is shadowed by an earlier
3807          one in the same keymap.  */
3808       if (!NILP (entire_map) && complete_char)
3809         {
3810           Lisp_Object tem;
3811
3812           tem = Flookup_key (entire_map, kludge, Qt);
3813
3814           if (!EQ (tem, definition))
3815             continue;
3816         }
3817
3818       if (first)
3819         {
3820           if (char_table_depth == 0)
3821             insert ("\n", 1);
3822           first = 0;
3823         }
3824
3825       /* For a sub char-table, show the depth by indentation.
3826          CHAR_TABLE_DEPTH can be greater than 0 only for a char-table.  */
3827       if (char_table_depth > 0)
3828         insert ("    ", char_table_depth * 2); /* depth is 1 or 2.  */
3829
3830       /* Output the prefix that applies to every entry in this map.  */
3831       if (!NILP (elt_prefix))
3832         insert1 (elt_prefix);
3833
3834       /* Insert or describe the character this slot is for,
3835          or a description of what it is for.  */
3836       if (SUB_CHAR_TABLE_P (vector))
3837         {
3838           if (complete_char)
3839             insert_char (character);
3840           else
3841             {
3842               /* We need an octal representation for this block of
3843                  characters.  */
3844               char work[16];
3845               sprintf (work, "(row %d)", i);
3846               insert (work, strlen (work));
3847             }
3848         }
3849       else if (CHAR_TABLE_P (vector))
3850         {
3851           if (complete_char)
3852             insert1 (Fkey_description (kludge, prefix));
3853           else
3854             {
3855               /* Print the information for this character set.  */
3856               insert_string ("<");
3857               tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3858               if (STRINGP (tem2))
3859                 insert_from_string (tem2, 0, 0, SCHARS (tem2),
3860                                     SBYTES (tem2), 0);
3861               else
3862                 insert ("?", 1);
3863               insert (">", 1);
3864             }
3865         }
3866       else
3867         {
3868           insert1 (Fkey_description (kludge, prefix));
3869         }
3870
3871       /* If we find a sub char-table within a char-table,
3872          scan it recursively; it defines the details for
3873          a character set or a portion of a character set.  */
3874       if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3875         {
3876           insert ("\n", 1);
3877           describe_vector (definition, prefix, args, elt_describer,
3878                            partial, shadow, entire_map,
3879                            indices, char_table_depth + 1, keymap_p,
3880                            mention_shadow);
3881           continue;
3882         }
3883
3884       starting_i = i;
3885
3886       /* Find all consecutive characters or rows that have the same
3887          definition.  But, for elements of a top level char table, if
3888          they are for charsets, we had better describe one by one even
3889          if they have the same definition.  */
3890       if (CHAR_TABLE_P (vector))
3891         {
3892           int limit = to;
3893
3894           if (char_table_depth == 0)
3895             limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3896
3897           while (i + 1 < limit
3898                  && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3899                      !NILP (tem2))
3900                  && !NILP (Fequal (tem2, definition)))
3901             i++;
3902         }
3903       else
3904         while (i + 1 < to
3905                && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3906                    !NILP (tem2))
3907                && !NILP (Fequal (tem2, definition)))
3908           i++;
3909
3910
3911       /* If we have a range of more than one character,
3912          print where the range reaches to.  */
3913
3914       if (i != starting_i)
3915         {
3916           insert (" .. ", 4);
3917
3918           ASET (kludge, 0, make_number (i));
3919
3920           if (!NILP (elt_prefix))
3921             insert1 (elt_prefix);
3922
3923           if (CHAR_TABLE_P (vector))
3924             {
3925               if (char_table_depth == 0)
3926                 {
3927                   insert1 (Fkey_description (kludge, prefix));
3928                 }
3929               else if (complete_char)
3930                 {
3931                   indices[char_table_depth] = i;
3932                   character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3933                   insert_char (character);
3934                 }
3935               else
3936                 {
3937                   /* We need an octal representation for this block of
3938                      characters.  */
3939                   char work[16];
3940                   sprintf (work, "(row %d)", i);
3941                   insert (work, strlen (work));
3942                 }
3943             }
3944           else
3945             {
3946               insert1 (Fkey_description (kludge, prefix));
3947             }
3948         }
3949
3950       /* Print a description of the definition of this character.
3951          elt_describer will take care of spacing out far enough
3952          for alignment purposes.  */
3953       (*elt_describer) (definition, args);
3954
3955       if (this_shadowed)
3956         {
3957           SET_PT (PT - 1);
3958           insert_string ("  (binding currently shadowed)");
3959           SET_PT (PT + 1);
3960         }
3961     }
3962
3963   /* For (sub) char-table, print `defalt' slot at last.  */
3964   if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3965     {
3966       insert ("    ", char_table_depth * 2);
3967       insert_string ("<<default>>");
3968       (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3969     }
3970
3971   UNGCPRO;
3972 }
3973 \f
3974 /* Apropos - finding all symbols whose names match a regexp.            */
3975 static Lisp_Object apropos_predicate;
3976 static Lisp_Object apropos_accumulate;
3977
3978 static void
3979 apropos_accum (symbol, string)
3980      Lisp_Object symbol, string;
3981 {
3982   register Lisp_Object tem;
3983
3984   tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3985   if (!NILP (tem) && !NILP (apropos_predicate))
3986     tem = call1 (apropos_predicate, symbol);
3987   if (!NILP (tem))
3988     apropos_accumulate = Fcons (symbol, apropos_accumulate);
3989 }
3990
3991 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3992        doc: /* Show all symbols whose names contain match for REGEXP.
3993 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3994 for each symbol and a symbol is mentioned only if that returns non-nil.
3995 Return list of symbols found.  */)
3996      (regexp, predicate)
3997      Lisp_Object regexp, predicate;
3998 {
3999   Lisp_Object tem;
4000   CHECK_STRING (regexp);
4001   apropos_predicate = predicate;
4002   apropos_accumulate = Qnil;
4003   map_obarray (Vobarray, apropos_accum, regexp);
4004   tem = Fsort (apropos_accumulate, Qstring_lessp);
4005   apropos_accumulate = Qnil;
4006   apropos_predicate = Qnil;
4007   return tem;
4008 }
4009 \f
4010 void
4011 syms_of_keymap ()
4012 {
4013   Qkeymap = intern ("keymap");
4014   staticpro (&Qkeymap);
4015   staticpro (&apropos_predicate);
4016   staticpro (&apropos_accumulate);
4017   apropos_predicate = Qnil;
4018   apropos_accumulate = Qnil;
4019
4020   /* Now we are ready to set up this property, so we can
4021      create char tables.  */
4022   Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
4023
4024   /* Initialize the keymaps standardly used.
4025      Each one is the value of a Lisp variable, and is also
4026      pointed to by a C variable */
4027
4028   global_map = Fmake_keymap (Qnil);
4029   Fset (intern ("global-map"), global_map);
4030
4031   current_global_map = global_map;
4032   staticpro (&global_map);
4033   staticpro (&current_global_map);
4034
4035   meta_map = Fmake_keymap (Qnil);
4036   Fset (intern ("esc-map"), meta_map);
4037   Ffset (intern ("ESC-prefix"), meta_map);
4038
4039   control_x_map = Fmake_keymap (Qnil);
4040   Fset (intern ("ctl-x-map"), control_x_map);
4041   Ffset (intern ("Control-X-prefix"), control_x_map);
4042
4043   exclude_keys
4044     = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
4045              Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
4046                     Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
4047                            Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
4048                                   Fcons (Fcons (build_string ("SPC"), build_string (" ")),
4049                                          Qnil)))));
4050   staticpro (&exclude_keys);
4051
4052   DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
4053                doc: /* List of commands given new key bindings recently.
4054 This is used for internal purposes during Emacs startup;
4055 don't alter it yourself.  */);
4056   Vdefine_key_rebound_commands = Qt;
4057
4058   DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
4059                doc: /* Default keymap to use when reading from the minibuffer.  */);
4060   Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
4061
4062   DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
4063                doc: /* Local keymap for the minibuffer when spaces are not allowed.  */);
4064   Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
4065   Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
4066
4067   DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
4068                doc: /* Local keymap for minibuffer input with completion.  */);
4069   Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
4070   Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
4071
4072   DEFVAR_LISP ("minibuffer-local-filename-completion-map",
4073                &Vminibuffer_local_filename_completion_map,
4074                doc: /* Local keymap for minibuffer input with completion for filenames.  */);
4075   Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
4076   Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
4077                       Vminibuffer_local_completion_map);
4078
4079
4080   DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
4081                doc: /* Local keymap for minibuffer input with completion, for exact match.  */);
4082   Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
4083   Fset_keymap_parent (Vminibuffer_local_must_match_map,
4084                       Vminibuffer_local_completion_map);
4085
4086   DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
4087                &Vminibuffer_local_must_match_filename_map,
4088                doc: /* Local keymap for minibuffer input with completion for filenames with exact match.  */);
4089   Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
4090   Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
4091                       Vminibuffer_local_must_match_map);
4092
4093   DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4094                doc: /* Alist of keymaps to use for minor modes.
4095 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4096 key sequences and look up bindings if VARIABLE's value is non-nil.
4097 If two active keymaps bind the same key, the keymap appearing earlier
4098 in the list takes precedence.  */);
4099   Vminor_mode_map_alist = Qnil;
4100
4101   DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4102                doc: /* Alist of keymaps to use for minor modes, in current major mode.
4103 This variable is an alist just like `minor-mode-map-alist', and it is
4104 used the same way (and before `minor-mode-map-alist'); however,
4105 it is provided for major modes to bind locally.  */);
4106   Vminor_mode_overriding_map_alist = Qnil;
4107
4108   DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4109                doc: /* List of keymap alists to use for emulations modes.
4110 It is intended for modes or packages using multiple minor-mode keymaps.
4111 Each element is a keymap alist just like `minor-mode-map-alist', or a
4112 symbol with a variable binding which is a keymap alist, and it is used
4113 the same way.  The "active" keymaps in each alist are used before
4114 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'.  */);
4115   Vemulation_mode_map_alists = Qnil;
4116
4117
4118   DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
4119                doc: /* Keymap that translates key sequences to key sequences during input.
4120 This is used mainly for mapping ASCII function key sequences into
4121 real Emacs function key events (symbols).
4122
4123 The `read-key-sequence' function replaces any subsequence bound by
4124 `function-key-map' with its binding.  More precisely, when the active
4125 keymaps have no binding for the current key sequence but
4126 `function-key-map' binds a suffix of the sequence to a vector or string,
4127 `read-key-sequence' replaces the matching suffix with its binding, and
4128 continues with the new sequence.
4129
4130 If the binding is a function, it is called with one argument (the prompt)
4131 and its return value (a key sequence) is used.
4132
4133 The events that come from bindings in `function-key-map' are not
4134 themselves looked up in `function-key-map'.
4135
4136 For example, suppose `function-key-map' binds `ESC O P' to [f1].
4137 Typing `ESC O P' to `read-key-sequence' would return [f1].  Typing
4138 `C-x ESC O P' would return [?\\C-x f1].  If [f1] were a prefix
4139 key, typing `ESC O P x' would return [f1 x].  */);
4140   Vfunction_key_map = Fmake_sparse_keymap (Qnil);
4141
4142   DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
4143                doc: /* Keymap of key translations that can override keymaps.
4144 This keymap works like `function-key-map', but comes after that,
4145 and its non-prefix bindings override ordinary bindings.  */);
4146   Vkey_translation_map = Qnil;
4147
4148   staticpro (&Vmouse_events);
4149   Vmouse_events = Fcons (intern ("menu-bar"),
4150                   Fcons (intern ("tool-bar"),
4151                   Fcons (intern ("header-line"),
4152                   Fcons (intern ("mode-line"),
4153                   Fcons (intern ("mouse-1"),
4154                   Fcons (intern ("mouse-2"),
4155                   Fcons (intern ("mouse-3"),
4156                   Fcons (intern ("mouse-4"),
4157                   Fcons (intern ("mouse-5"),
4158                          Qnil)))))))));
4159
4160
4161   Qsingle_key_description = intern ("single-key-description");
4162   staticpro (&Qsingle_key_description);
4163
4164   Qkey_description = intern ("key-description");
4165   staticpro (&Qkey_description);
4166
4167   Qkeymapp = intern ("keymapp");
4168   staticpro (&Qkeymapp);
4169
4170   Qnon_ascii = intern ("non-ascii");
4171   staticpro (&Qnon_ascii);
4172
4173   Qmenu_item = intern ("menu-item");
4174   staticpro (&Qmenu_item);
4175
4176   Qremap = intern ("remap");
4177   staticpro (&Qremap);
4178
4179   command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4180   staticpro (&command_remapping_vector);
4181
4182   where_is_cache_keymaps = Qt;
4183   where_is_cache = Qnil;
4184   staticpro (&where_is_cache);
4185   staticpro (&where_is_cache_keymaps);
4186
4187   defsubr (&Skeymapp);
4188   defsubr (&Skeymap_parent);
4189   defsubr (&Skeymap_prompt);
4190   defsubr (&Sset_keymap_parent);
4191   defsubr (&Smake_keymap);
4192   defsubr (&Smake_sparse_keymap);
4193   defsubr (&Smap_keymap);
4194   defsubr (&Scopy_keymap);
4195   defsubr (&Scommand_remapping);
4196   defsubr (&Skey_binding);
4197   defsubr (&Slocal_key_binding);
4198   defsubr (&Sglobal_key_binding);
4199   defsubr (&Sminor_mode_key_binding);
4200   defsubr (&Sdefine_key);
4201   defsubr (&Slookup_key);
4202   defsubr (&Sdefine_prefix_command);
4203   defsubr (&Suse_global_map);
4204   defsubr (&Suse_local_map);
4205   defsubr (&Scurrent_local_map);
4206   defsubr (&Scurrent_global_map);
4207   defsubr (&Scurrent_minor_mode_maps);
4208   defsubr (&Scurrent_active_maps);
4209   defsubr (&Saccessible_keymaps);
4210   defsubr (&Skey_description);
4211   defsubr (&Sdescribe_vector);
4212   defsubr (&Ssingle_key_description);
4213   defsubr (&Stext_char_description);
4214   defsubr (&Swhere_is_internal);
4215   defsubr (&Sdescribe_buffer_bindings);
4216   defsubr (&Sapropos_internal);
4217 }
4218
4219 void
4220 keys_of_keymap ()
4221 {
4222   initial_define_key (global_map, 033, "ESC-prefix");
4223   initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
4224 }
4225
4226 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4227    (do not change this comment) */