src/keymap.c

   1 /* Manipulation of keymaps
   2    Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <config.h>
  22 #include <stdio.h>
  23 #undef NULL
  24 #include "lisp.h"
  25 #include "commands.h"
  26 #include "buffer.h"
  27 #include "keyboard.h"
  28 #include "termhooks.h"
  29 #include "blockinput.h"
  30
  31 #define min(a, b) ((a) < (b) ? (a) : (b))
  32
  33 /* The number of elements in keymap vectors.  */
  34 #define DENSE_TABLE_SIZE (0200)
  35
  36 /* Actually allocate storage for these variables */
  37
  38 Lisp_Object current_global_map; /* Current global keymap */
  39
  40 Lisp_Object global_map;         /* default global key bindings */
  41
  42 Lisp_Object meta_map;           /* The keymap used for globally bound
  43                                    ESC-prefixed default commands */
  44
  45 Lisp_Object control_x_map;      /* The keymap used for globally bound
  46                                    C-x-prefixed default commands */
  47
  48 /* was MinibufLocalMap */
  49 Lisp_Object Vminibuffer_local_map;
  50                                 /* The keymap used by the minibuf for local
  51                                    bindings when spaces are allowed in the
  52                                    minibuf */
  53
  54 /* was MinibufLocalNSMap */
  55 Lisp_Object Vminibuffer_local_ns_map;
  56                                 /* The keymap used by the minibuf for local
  57                                    bindings when spaces are not encouraged
  58                                    in the minibuf */
  59
  60 /* keymap used for minibuffers when doing completion */
  61 /* was MinibufLocalCompletionMap */
  62 Lisp_Object Vminibuffer_local_completion_map;
  63
  64 /* keymap used for minibuffers when doing completion and require a match */
  65 /* was MinibufLocalMustMatchMap */
  66 Lisp_Object Vminibuffer_local_must_match_map;
  67
  68 /* Alist of minor mode variables and keymaps.  */
  69 Lisp_Object Vminor_mode_map_alist;
  70
  71 /* Keymap mapping ASCII function key sequences onto their preferred forms.
  72    Initialized by the terminal-specific lisp files.  See DEFVAR for more
  73    documentation.  */
  74 Lisp_Object Vfunction_key_map;
  75
  76 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii;
  77
  78 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
  79    in a string key sequence is equivalent to prefixing with this
  80    character.  */
  81 extern Lisp_Object meta_prefix_char;
  82
  83 extern Lisp_Object Voverriding_local_map;
  84
  85 void describe_map_tree ();
  86 static Lisp_Object define_as_prefix ();
  87 static Lisp_Object describe_buffer_bindings ();
  88 static void describe_command ();
  89 static void describe_map ();
  90 static void describe_map_2 ();
  91 \f
  92 /* Keymap object support - constructors and predicates.                 */
  93
  94 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
  95   "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\
  96 VECTOR is a vector which holds the bindings for the ASCII\n\
  97 characters.  ALIST is an assoc-list which holds bindings for function keys,\n\
  98 mouse events, and any other things that appear in the input stream.\n\
  99 All entries in it are initially nil, meaning \"command undefined\".\n\n\
 100 The optional arg STRING supplies a menu name for the keymap\n\
 101 in case you use it as a menu with `x-popup-menu'.")
 102   (string)
 103      Lisp_Object string;
 104 {
 105   Lisp_Object tail;
 106   if (!NILP (string))
 107     tail = Fcons (string, Qnil);
 108   else
 109     tail = Qnil;
 110   return Fcons (Qkeymap,
 111                 Fcons (Fmake_vector (make_number (DENSE_TABLE_SIZE), Qnil),
 112                        tail));
 113 }
 114
 115 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
 116   "Construct and return a new sparse-keymap list.\n\
 117 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
 118 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
 119 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
 120 Initially the alist is nil.\n\n\
 121 The optional arg STRING supplies a menu name for the keymap\n\
 122 in case you use it as a menu with `x-popup-menu'.")
 123   (string)
 124      Lisp_Object string;
 125 {
 126   if (!NILP (string))
 127     return Fcons (Qkeymap, Fcons (string, Qnil));
 128   return Fcons (Qkeymap, Qnil);
 129 }
 130
 131 /* This function is used for installing the standard key bindings
 132    at initialization time.
 133
 134    For example:
 135
 136    initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");  */
 137
 138 void
 139 initial_define_key (keymap, key, defname)
 140      Lisp_Object keymap;
 141      int key;
 142      char *defname;
 143 {
 144   store_in_keymap (keymap, make_number (key), intern (defname));
 145 }
 146
 147 void
 148 initial_define_lispy_key (keymap, keyname, defname)
 149      Lisp_Object keymap;
 150      char *keyname;
 151      char *defname;
 152 {
 153   store_in_keymap (keymap, intern (keyname), intern (defname));
 154 }
 155
 156 /* Define character fromchar in map frommap as an alias for character
 157    tochar in map tomap.  Subsequent redefinitions of the latter WILL
 158    affect the former. */
 159
 160 #if 0
 161 void
 162 synkey (frommap, fromchar, tomap, tochar)
 163      struct Lisp_Vector *frommap, *tomap;
 164      int fromchar, tochar;
 165 {
 166   Lisp_Object v, c;
 167   XSET (v, Lisp_Vector, tomap);
 168   XFASTINT (c) = tochar;
 169   frommap->contents[fromchar] = Fcons (v, c);
 170 }
 171 #endif /* 0 */
 172
 173 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
 174   "Return t if ARG is a keymap.\n\
 175 \n\
 176 A keymap is a list (keymap . ALIST),\n\
 177 or a symbol whose function definition is itself a keymap.\n\
 178 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
 179 a vector of densely packed bindings for small character codes\n\
 180 is also allowed as an element.")
 181   (object)
 182      Lisp_Object object;
 183 {
 184   return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
 185 }
 186
 187 /* Check that OBJECT is a keymap (after dereferencing through any
 188    symbols).  If it is, return it.
 189
 190    If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
 191    is an autoload form, do the autoload and try again.
 192
 193    ERROR controls how we respond if OBJECT isn't a keymap.
 194    If ERROR is non-zero, signal an error; otherwise, just return Qnil.
 195
 196    Note that most of the time, we don't want to pursue autoloads.
 197    Functions like Faccessible_keymaps which scan entire keymap trees
 198    shouldn't load every autoloaded keymap.  I'm not sure about this,
 199    but it seems to me that only read_key_sequence, Flookup_key, and
 200    Fdefine_key should cause keymaps to be autoloaded.  */
 201
 202 Lisp_Object
 203 get_keymap_1 (object, error, autoload)
 204      Lisp_Object object;
 205      int error, autoload;
 206 {
 207   Lisp_Object tem;
 208
 209  autoload_retry:
 210   tem = indirect_function (object);
 211   if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
 212     return tem;
 213
 214   /* Should we do an autoload?  Autoload forms for keymaps have
 215      Qkeymap as their fifth element.  */
 216   if (autoload
 217       && XTYPE (object) == Lisp_Symbol
 218       && CONSP (tem)
 219       && EQ (XCONS (tem)->car, Qautoload))
 220     {
 221       Lisp_Object tail;
 222
 223       tail = Fnth (make_number (4), tem);
 224       if (EQ (tail, Qkeymap))
 225         {
 226           struct gcpro gcpro1, gcpro2;
 227
 228           GCPRO2 (tem, object);
 229           do_autoload (tem, object);
 230           UNGCPRO;
 231
 232           goto autoload_retry;
 233         }
 234     }
 235
 236   if (error)
 237     wrong_type_argument (Qkeymapp, object);
 238   else
 239     return Qnil;
 240 }
 241
 242
 243 /* Follow any symbol chaining, and return the keymap denoted by OBJECT.
 244    If OBJECT doesn't denote a keymap at all, signal an error.  */
 245 Lisp_Object
 246 get_keymap (object)
 247      Lisp_Object object;
 248 {
 249   return get_keymap_1 (object, 0, 0);
 250 }
 251
 252
 253 /* Look up IDX in MAP.  IDX may be any sort of event.
 254    Note that this does only one level of lookup; IDX must be a single
 255    event, not a sequence.
 256
 257    If T_OK is non-zero, bindings for Qt are treated as default
 258    bindings; any key left unmentioned by other tables and bindings is
 259    given the binding of Qt.
 260
 261    If T_OK is zero, bindings for Qt are not treated specially.
 262
 263    If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */
 264
 265 Lisp_Object
 266 access_keymap (map, idx, t_ok, noinherit)
 267      Lisp_Object map;
 268      Lisp_Object idx;
 269      int t_ok;
 270      int noinherit;
 271 {
 272   int noprefix = 0;
 273   Lisp_Object val;
 274
 275   /* If idx is a list (some sort of mouse click, perhaps?),
 276      the index we want to use is the car of the list, which
 277      ought to be a symbol.  */
 278   idx = EVENT_HEAD (idx);
 279
 280   /* If idx is a symbol, it might have modifiers, which need to
 281      be put in the canonical order.  */
 282   if (XTYPE (idx) == Lisp_Symbol)
 283     idx = reorder_modifiers (idx);
 284   else if (INTEGERP (idx))
 285     /* Clobber the high bits that can be present on a machine
 286        with more than 24 bits of integer.  */
 287     XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1));
 288
 289   {
 290     Lisp_Object tail;
 291     Lisp_Object t_binding;
 292
 293     t_binding = Qnil;
 294     for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr)
 295       {
 296         Lisp_Object binding;
 297
 298         binding = XCONS (tail)->car;
 299         switch (XTYPE (binding))
 300           {
 301           case Lisp_Symbol:
 302             /* If NOINHERIT, stop finding prefix definitions
 303                after we pass a second occurrence of the `keymap' symbol.  */
 304             if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
 305               noprefix = 1;
 306             break;
 307
 308           case Lisp_Cons:
 309             if (EQ (XCONS (binding)->car, idx))
 310               {
 311                 val = XCONS (binding)->cdr;
 312                 if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
 313                   return Qnil;
 314                 return val;
 315               }
 316             if (t_ok && EQ (XCONS (binding)->car, Qt))
 317               t_binding = XCONS (binding)->cdr;
 318             break;
 319
 320           case Lisp_Vector:
 321             if (XTYPE (idx) == Lisp_Int
 322                 && XINT (idx) >= 0
 323                 && XINT (idx) < XVECTOR (binding)->size)
 324               {
 325                 val = XVECTOR (binding)->contents[XINT (idx)];
 326                 if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
 327                   return Qnil;
 328                 return val;
 329               }
 330             break;
 331           }
 332
 333         QUIT;
 334       }
 335
 336     return t_binding;
 337   }
 338 }
 339
 340 /* Given OBJECT which was found in a slot in a keymap,
 341    trace indirect definitions to get the actual definition of that slot.
 342    An indirect definition is a list of the form
 343    (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
 344    and INDEX is the object to look up in KEYMAP to yield the definition.
 345
 346    Also if OBJECT has a menu string as the first element,
 347    remove that.  Also remove a menu help string as second element.  */
 348
 349 Lisp_Object
 350 get_keyelt (object)
 351      register Lisp_Object object;
 352 {
 353   while (1)
 354     {
 355       register Lisp_Object map, tem;
 356
 357       /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
 358       map = get_keymap_1 (Fcar_safe (object), 0, 0);
 359       tem = Fkeymapp (map);
 360       if (!NILP (tem))
 361         object = access_keymap (map, Fcdr (object), 0, 0);
 362
 363       /* If the keymap contents looks like (STRING . DEFN),
 364          use DEFN.
 365          Keymap alist elements like (CHAR MENUSTRING . DEFN)
 366          will be used by HierarKey menus.  */
 367       else if (XTYPE (object) == Lisp_Cons
 368                && XTYPE (XCONS (object)->car) == Lisp_String)
 369         {
 370           object = XCONS (object)->cdr;
 371           /* Also remove a menu help string, if any,
 372              following the menu item name.  */
 373           if (XTYPE (object) == Lisp_Cons
 374               && XTYPE (XCONS (object)->car) == Lisp_String)
 375             object = XCONS (object)->cdr;
 376           /* Also remove the sublist that caches key equivalences, if any.  */
 377           if (CONSP (object)
 378               && CONSP (XCONS (object)->car))
 379             {
 380               Lisp_Object carcar;
 381               carcar = XCONS (XCONS (object)->car)->car;
 382               if (NILP (carcar) || VECTORP (carcar))
 383                 object = XCONS (object)->cdr;
 384             }
 385         }
 386
 387       else
 388         /* Anything else is really the value.  */
 389         return object;
 390     }
 391 }
 392
 393 Lisp_Object
 394 store_in_keymap (keymap, idx, def)
 395      Lisp_Object keymap;
 396      register Lisp_Object idx;
 397      register Lisp_Object def;
 398 {
 399   if (XTYPE (keymap) != Lisp_Cons
 400       || ! EQ (XCONS (keymap)->car, Qkeymap))
 401     error ("attempt to define a key in a non-keymap");
 402
 403   /* If idx is a list (some sort of mouse click, perhaps?),
 404      the index we want to use is the car of the list, which
 405      ought to be a symbol.  */
 406   idx = EVENT_HEAD (idx);
 407
 408   /* If idx is a symbol, it might have modifiers, which need to
 409      be put in the canonical order.  */
 410   if (XTYPE (idx) == Lisp_Symbol)
 411     idx = reorder_modifiers (idx);
 412   else if (INTEGERP (idx))
 413     /* Clobber the high bits that can be present on a machine
 414        with more than 24 bits of integer.  */
 415     XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1));
 416
 417   /* Scan the keymap for a binding of idx.  */
 418   {
 419     Lisp_Object tail;
 420
 421     /* The cons after which we should insert new bindings.  If the
 422        keymap has a table element, we record its position here, so new
 423        bindings will go after it; this way, the table will stay
 424        towards the front of the alist and character lookups in dense
 425        keymaps will remain fast.  Otherwise, this just points at the
 426        front of the keymap.  */
 427     Lisp_Object insertion_point;
 428
 429     insertion_point = keymap;
 430     for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = XCONS (tail)->cdr)
 431       {
 432         Lisp_Object elt;
 433
 434         elt = XCONS (tail)->car;
 435         switch (XTYPE (elt))
 436           {
 437           case Lisp_Vector:
 438             if (XTYPE (idx) == Lisp_Int
 439                 && XINT (idx) >= 0 && XINT (idx) < XVECTOR (elt)->size)
 440               {
 441                 XVECTOR (elt)->contents[XFASTINT (idx)] = def;
 442                 return def;
 443               }
 444             insertion_point = tail;
 445             break;
 446
 447           case Lisp_Cons:
 448             if (EQ (idx, XCONS (elt)->car))
 449               {
 450                 XCONS (elt)->cdr = def;
 451                 return def;
 452               }
 453             break;
 454
 455           case Lisp_Symbol:
 456             /* If we find a 'keymap' symbol in the spine of KEYMAP,
 457                then we must have found the start of a second keymap
 458                being used as the tail of KEYMAP, and a binding for IDX
 459                should be inserted before it.  */
 460             if (EQ (elt, Qkeymap))
 461               goto keymap_end;
 462             break;
 463           }
 464
 465         QUIT;
 466       }
 467
 468   keymap_end:
 469     /* We have scanned the entire keymap, and not found a binding for
 470        IDX.  Let's add one.  */
 471     XCONS (insertion_point)->cdr =
 472       Fcons (Fcons (idx, def), XCONS (insertion_point)->cdr);
 473   }
 474
 475   return def;
 476 }
 477
 478
 479 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
 480   "Return a copy of the keymap KEYMAP.\n\
 481 The copy starts out with the same definitions of KEYMAP,\n\
 482 but changing either the copy or KEYMAP does not affect the other.\n\
 483 Any key definitions that are subkeymaps are recursively copied.\n\
 484 However, a key definition which is a symbol whose definition is a keymap\n\
 485 is not copied.")
 486   (keymap)
 487      Lisp_Object keymap;
 488 {
 489   register Lisp_Object copy, tail;
 490
 491   copy = Fcopy_alist (get_keymap (keymap));
 492
 493   for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr)
 494     {
 495       Lisp_Object elt;
 496
 497       elt = XCONS (tail)->car;
 498       if (XTYPE (elt) == Lisp_Vector)
 499         {
 500           int i;
 501
 502           elt = Fcopy_sequence (elt);
 503           XCONS (tail)->car = elt;
 504
 505           for (i = 0; i < XVECTOR (elt)->size; i++)
 506             if (XTYPE (XVECTOR (elt)->contents[i]) != Lisp_Symbol
 507                 && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i])))
 508               XVECTOR (elt)->contents[i] =
 509                 Fcopy_keymap (XVECTOR (elt)->contents[i]);
 510         }
 511       else if (CONSP (elt))
 512         {
 513           /* Skip the optional menu string.  */
 514           if (CONSP (XCONS (elt)->cdr)
 515               && STRINGP (XCONS (XCONS (elt)->cdr)->car))
 516             {
 517               Lisp_Object tem;
 518
 519               /* Copy the cell, since copy-alist didn't go this deep.  */
 520               XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
 521                                         XCONS (XCONS (elt)->cdr)->cdr);
 522               elt = XCONS (elt)->cdr;
 523
 524               /* Also skip the optional menu help string.  */
 525               if (CONSP (XCONS (elt)->cdr)
 526                   && STRINGP (XCONS (XCONS (elt)->cdr)->car))
 527                 {
 528                   XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
 529                                             XCONS (XCONS (elt)->cdr)->cdr);
 530                   elt = XCONS (elt)->cdr;
 531                 }
 532               /* There may also be a list that caches key equivalences.
 533                  Just delete it for the new keymap.  */
 534               if (CONSP (XCONS (elt)->cdr)
 535                   && CONSP (XCONS (XCONS (elt)->cdr)->car)
 536                   && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car)
 537                       || VECTORP (tem)))
 538                 XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr;
 539             }
 540           if (CONSP (elt)
 541               && ! SYMBOLP (XCONS (elt)->cdr)
 542               && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
 543             XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
 544         }
 545     }
 546
 547   return copy;
 548 }
 549 \f
 550 /* Simple Keymap mutators and accessors.                                */
 551
 552 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
 553   "Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.\n\
 554 KEYMAP is a keymap.  KEY is a string or a vector of symbols and characters\n\
 555 meaning a sequence of keystrokes and events.\n\
 556 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
 557 can be included if you use a vector.\n\
 558 DEF is anything that can be a key's definition:\n\
 559  nil (means key is undefined in this keymap),\n\
 560  a command (a Lisp function suitable for interactive calling)\n\
 561  a string (treated as a keyboard macro),\n\
 562  a keymap (to define a prefix key),\n\
 563  a symbol.  When the key is looked up, the symbol will stand for its\n\
 564     function definition, which should at that time be one of the above,\n\
 565     or another symbol whose function definition is used, etc.\n\
 566  a cons (STRING . DEFN), meaning that DEFN is the definition\n\
 567     (DEFN should be a valid definition in its own right),\n\
 568  or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
 569 \n\
 570 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
 571 the front of KEYMAP.")
 572   (keymap, key, def)
 573      Lisp_Object keymap;
 574      Lisp_Object key;
 575      Lisp_Object def;
 576 {
 577   register int idx;
 578   register Lisp_Object c;
 579   register Lisp_Object tem;
 580   register Lisp_Object cmd;
 581   int metized = 0;
 582   int meta_bit;
 583   int length;
 584   struct gcpro gcpro1, gcpro2, gcpro3;
 585
 586   keymap = get_keymap (keymap);
 587
 588   if (XTYPE (key) != Lisp_Vector
 589       && XTYPE (key) != Lisp_String)
 590     key = wrong_type_argument (Qarrayp, key);
 591
 592   length = XFASTINT (Flength (key));
 593   if (length == 0)
 594     return Qnil;
 595
 596   GCPRO3 (keymap, key, def);
 597
 598   if (XTYPE (key) == Lisp_Vector)
 599     meta_bit = meta_modifier;
 600   else
 601     meta_bit = 0x80;
 602
 603   idx = 0;
 604   while (1)
 605     {
 606       c = Faref (key, make_number (idx));
 607
 608       if (XTYPE (c) == Lisp_Int
 609           && (XINT (c) & meta_bit)
 610           && !metized)
 611         {
 612           c = meta_prefix_char;
 613           metized = 1;
 614         }
 615       else
 616         {
 617           if (XTYPE (c) == Lisp_Int)
 618             XSETINT (c, XINT (c) & ~meta_bit);
 619
 620           metized = 0;
 621           idx++;
 622         }
 623
 624       if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
 625         error ("Key sequence contains illegal events");
 626
 627       if (idx == length)
 628         RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
 629
 630       cmd = get_keyelt (access_keymap (keymap, c, 0, 1));
 631
 632       /* If this key is undefined, make it a prefix.  */
 633       if (NILP (cmd))
 634         cmd = define_as_prefix (keymap, c);
 635
 636       keymap = get_keymap_1 (cmd, 0, 1);
 637       if (NILP (keymap))
 638         /* We must use Fkey_description rather than just passing key to
 639            error; key might be a vector, not a string.  */
 640         error ("Key sequence %s uses invalid prefix characters",
 641                XSTRING (Fkey_description (key))->data);
 642     }
 643 }
 644
 645 /* Value is number if KEY is too long; NIL if valid but has no definition. */
 646
 647 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
 648   "In keymap KEYMAP, look up key sequence KEY.  Return the definition.\n\
 649 nil means undefined.  See doc of `define-key' for kinds of definitions.\n\
 650 \n\
 651 A number as value means KEY is \"too long\";\n\
 652 that is, characters or symbols in it except for the last one\n\
 653 fail to be a valid sequence of prefix characters in KEYMAP.\n\
 654 The number is how many characters at the front of KEY\n\
 655 it takes to reach a non-prefix command.\n\
 656 \n\
 657 Normally, `lookup-key' ignores bindings for t, which act as default\n\
 658 bindings, used when nothing else in the keymap applies; this makes it\n\
 659 useable as a general function for probing keymaps.  However, if the\n\
 660 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
 661 recognize the default bindings, just as `read-key-sequence' does.")
 662   (keymap, key, accept_default)
 663      register Lisp_Object keymap;
 664      Lisp_Object key;
 665      Lisp_Object accept_default;
 666 {
 667   register int idx;
 668   register Lisp_Object tem;
 669   register Lisp_Object cmd;
 670   register Lisp_Object c;
 671   int metized = 0;
 672   int length;
 673   int t_ok = ! NILP (accept_default);
 674   int meta_bit;
 675
 676   keymap = get_keymap (keymap);
 677
 678   if (XTYPE (key) != Lisp_Vector
 679       && XTYPE (key) != Lisp_String)
 680     key = wrong_type_argument (Qarrayp, key);
 681
 682   length = XFASTINT (Flength (key));
 683   if (length == 0)
 684     return keymap;
 685
 686   if (XTYPE (key) == Lisp_Vector)
 687     meta_bit = meta_modifier;
 688   else
 689     meta_bit = 0x80;
 690
 691   idx = 0;
 692   while (1)
 693     {
 694       c = Faref (key, make_number (idx));
 695
 696       if (XTYPE (c) == Lisp_Int
 697           && (XINT (c) & meta_bit)
 698           && !metized)
 699         {
 700           c = meta_prefix_char;
 701           metized = 1;
 702         }
 703       else
 704         {
 705           if (XTYPE (c) == Lisp_Int)
 706             XSETINT (c, XINT (c) & ~meta_bit);
 707
 708           metized = 0;
 709           idx++;
 710         }
 711
 712       cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0));
 713       if (idx == length)
 714         return cmd;
 715
 716       keymap = get_keymap_1 (cmd, 0, 0);
 717       if (NILP (keymap))
 718         return make_number (idx);
 719
 720       QUIT;
 721     }
 722 }
 723
 724 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
 725    Assume that currently it does not define C at all.
 726    Return the keymap.  */
 727
 728 static Lisp_Object
 729 define_as_prefix (keymap, c)
 730      Lisp_Object keymap, c;
 731 {
 732   Lisp_Object inherit, cmd;
 733
 734   cmd = Fmake_sparse_keymap (Qnil);
 735   /* If this key is defined as a prefix in an inherited keymap,
 736      make it a prefix in this map, and make its definition
 737      inherit the other prefix definition.  */
 738   inherit = access_keymap (keymap, c, 0, 0);
 739   if (NILP (inherit))
 740     {
 741       /* If there's an inherited keymap
 742          and it doesn't define this key,
 743          make it define this key.  */
 744       Lisp_Object tail;
 745
 746       for (tail = Fcdr (keymap); CONSP (tail); tail = XCONS (tail)->cdr)
 747         if (EQ (XCONS (tail)->car, Qkeymap))
 748           break;
 749
 750       if (!NILP (tail))
 751         inherit = define_as_prefix (tail, c);
 752     }
 753
 754   cmd = nconc2 (cmd, inherit);
 755   store_in_keymap (keymap, c, cmd);
 756
 757   return cmd;
 758 }
 759
 760 /* Append a key to the end of a key sequence.  We always make a vector.  */
 761
 762 Lisp_Object
 763 append_key (key_sequence, key)
 764      Lisp_Object key_sequence, key;
 765 {
 766   Lisp_Object args[2];
 767
 768   args[0] = key_sequence;
 769
 770   args[1] = Fcons (key, Qnil);
 771   return Fvconcat (2, args);
 772 }
 773
 774 \f
 775 /* Global, local, and minor mode keymap stuff.                          */
 776
 777 /* We can't put these variables inside current_minor_maps, since under
 778    some systems, static gets macro-defined to be the empty string.
 779    Ickypoo.  */
 780 static Lisp_Object *cmm_modes, *cmm_maps;
 781 static int cmm_size;
 782
 783 /* Store a pointer to an array of the keymaps of the currently active
 784    minor modes in *buf, and return the number of maps it contains.
 785
 786    This function always returns a pointer to the same buffer, and may
 787    free or reallocate it, so if you want to keep it for a long time or
 788    hand it out to lisp code, copy it.  This procedure will be called
 789    for every key sequence read, so the nice lispy approach (return a
 790    new assoclist, list, what have you) for each invocation would
 791    result in a lot of consing over time.
 792
 793    If we used xrealloc/xmalloc and ran out of memory, they would throw
 794    back to the command loop, which would try to read a key sequence,
 795    which would call this function again, resulting in an infinite
 796    loop.  Instead, we'll use realloc/malloc and silently truncate the
 797    list, let the key sequence be read, and hope some other piece of
 798    code signals the error.  */
 799 int
 800 current_minor_maps (modeptr, mapptr)
 801      Lisp_Object **modeptr, **mapptr;
 802 {
 803   int i = 0;
 804   Lisp_Object alist, assoc, var, val;
 805
 806   for (alist = Vminor_mode_map_alist;
 807        CONSP (alist);
 808        alist = XCONS (alist)->cdr)
 809     if (CONSP (assoc = XCONS (alist)->car)
 810         && XTYPE (var = XCONS (assoc)->car) == Lisp_Symbol
 811         && ! EQ ((val = find_symbol_value (var)), Qunbound)
 812         && ! NILP (val))
 813       {
 814         if (i >= cmm_size)
 815           {
 816             Lisp_Object *newmodes, *newmaps;
 817
 818             if (cmm_maps)
 819               {
 820                 BLOCK_INPUT;
 821                 cmm_size *= 2;
 822                 newmodes
 823                   = (Lisp_Object *) realloc (cmm_modes,
 824                                              cmm_size * sizeof (Lisp_Object));
 825                 newmaps
 826                   = (Lisp_Object *) realloc (cmm_maps,
 827                                              cmm_size * sizeof (Lisp_Object));
 828                 UNBLOCK_INPUT;
 829               }
 830             else
 831               {
 832                 BLOCK_INPUT;
 833                 cmm_size = 30;
 834                 newmodes
 835                   = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
 836                 newmaps
 837                   = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
 838                 UNBLOCK_INPUT;
 839               }
 840
 841             if (newmaps && newmodes)
 842               {
 843                 cmm_modes = newmodes;
 844                 cmm_maps = newmaps;
 845               }
 846             else
 847               break;
 848           }
 849         cmm_modes[i] = var;
 850         cmm_maps [i] = Findirect_function (XCONS (assoc)->cdr);
 851         i++;
 852       }
 853
 854   if (modeptr) *modeptr = cmm_modes;
 855   if (mapptr)  *mapptr  = cmm_maps;
 856   return i;
 857 }
 858
 859 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
 860   "Return the binding for command KEY in current keymaps.\n\
 861 KEY is a string or vector, a sequence of keystrokes.\n\
 862 The binding is probably a symbol with a function definition.\n\
 863 \n\
 864 Normally, `key-binding' ignores bindings for t, which act as default\n\
 865 bindings, used when nothing else in the keymap applies; this makes it\n\
 866 usable as a general function for probing keymaps.  However, if the\n\
 867 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
 868 recognize the default bindings, just as `read-key-sequence' does.")
 869   (key, accept_default)
 870      Lisp_Object key;
 871 {
 872   Lisp_Object *maps, value;
 873   int nmaps, i;
 874
 875   if (!NILP (Voverriding_local_map))
 876     {
 877       value = Flookup_key (Voverriding_local_map, key, accept_default);
 878       if (! NILP (value) && XTYPE (value) != Lisp_Int)
 879         return value;
 880     }
 881   else
 882     {
 883       nmaps = current_minor_maps (0, &maps);
 884       for (i = 0; i < nmaps; i++)
 885         if (! NILP (maps[i]))
 886           {
 887             value = Flookup_key (maps[i], key, accept_default);
 888             if (! NILP (value) && XTYPE (value) != Lisp_Int)
 889               return value;
 890           }
 891
 892       if (! NILP (current_buffer->keymap))
 893         {
 894           value = Flookup_key (current_buffer->keymap, key, accept_default);
 895           if (! NILP (value) && XTYPE (value) != Lisp_Int)
 896             return value;
 897         }
 898     }
 899
 900   value = Flookup_key (current_global_map, key, accept_default);
 901   if (! NILP (value) && XTYPE (value) != Lisp_Int)
 902     return value;
 903
 904   return Qnil;
 905 }
 906
 907 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
 908   "Return the binding for command KEYS in current local keymap only.\n\
 909 KEYS is a string, a sequence of keystrokes.\n\
 910 The binding is probably a symbol with a function definition.\n\
 911 \n\
 912 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
 913 bindings; see the description of `lookup-key' for more details about this.")
 914   (keys, accept_default)
 915      Lisp_Object keys, accept_default;
 916 {
 917   register Lisp_Object map;
 918   map = current_buffer->keymap;
 919   if (NILP (map))
 920     return Qnil;
 921   return Flookup_key (map, keys, accept_default);
 922 }
 923
 924 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
 925   "Return the binding for command KEYS in current global keymap only.\n\
 926 KEYS is a string, a sequence of keystrokes.\n\
 927 The binding is probably a symbol with a function definition.\n\
 928 This function's return values are the same as those of lookup-key\n\
 929 (which see).\n\
 930 \n\
 931 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
 932 bindings; see the description of `lookup-key' for more details about this.")
 933   (keys, accept_default)
 934      Lisp_Object keys, accept_default;
 935 {
 936   return Flookup_key (current_global_map, keys, accept_default);
 937 }
 938
 939 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
 940   "Find the visible minor mode bindings of KEY.\n\
 941 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
 942 the symbol which names the minor mode binding KEY, and BINDING is\n\
 943 KEY's definition in that mode.  In particular, if KEY has no\n\
 944 minor-mode bindings, return nil.  If the first binding is a\n\
 945 non-prefix, all subsequent bindings will be omitted, since they would\n\
 946 be ignored.  Similarly, the list doesn't include non-prefix bindings\n\
 947 that come after prefix bindings.\n\
 948 \n\
 949 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
 950 bindings; see the description of `lookup-key' for more details about this.")
 951   (key, accept_default)
 952      Lisp_Object key, accept_default;
 953 {
 954   Lisp_Object *modes, *maps;
 955   int nmaps;
 956   Lisp_Object binding;
 957   int i, j;
 958
 959   nmaps = current_minor_maps (&modes, &maps);
 960
 961   for (i = j = 0; i < nmaps; i++)
 962     if (! NILP (maps[i])
 963         && ! NILP (binding = Flookup_key (maps[i], key, accept_default))
 964         && XTYPE (binding) != Lisp_Int)
 965       {
 966         if (! NILP (get_keymap (binding)))
 967           maps[j++] = Fcons (modes[i], binding);
 968         else if (j == 0)
 969           return Fcons (Fcons (modes[i], binding), Qnil);
 970       }
 971
 972   return Flist (j, maps);
 973 }
 974
 975 DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
 976   "kSet key globally: \nCSet key %s to command: ",
 977   "Give KEY a global binding as COMMAND.\n\
 978 COMMAND is a symbol naming an interactively-callable function.\n\
 979 KEY is a key sequence (a string or vector of characters or event types).\n\
 980 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
 981 can be included if you use a vector.\n\
 982 Note that if KEY has a local binding in the current buffer\n\
 983 that local binding will continue to shadow any global binding.")
 984   (keys, function)
 985      Lisp_Object keys, function;
 986 {
 987   if (XTYPE (keys) != Lisp_Vector
 988       && XTYPE (keys) != Lisp_String)
 989     keys = wrong_type_argument (Qarrayp, keys);
 990
 991   Fdefine_key (current_global_map, keys, function);
 992   return Qnil;
 993 }
 994
 995 DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2,
 996   "kSet key locally: \nCSet key %s locally to command: ",
 997   "Give KEY a local binding as COMMAND.\n\
 998 COMMAND is a symbol naming an interactively-callable function.\n\
 999 KEY is a key sequence (a string or vector of characters or event types).\n\
1000 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
1001 can be included if you use a vector.\n\
1002 The binding goes in the current buffer's local map,\n\
1003 which in most cases is shared with all other buffers in the same major mode.")
1004   (keys, function)
1005      Lisp_Object keys, function;
1006 {
1007   register Lisp_Object map;
1008   map = current_buffer->keymap;
1009   if (NILP (map))
1010     {
1011       map = Fmake_sparse_keymap (Qnil);
1012       current_buffer->keymap = map;
1013     }
1014
1015   if (XTYPE (keys) != Lisp_Vector
1016       && XTYPE (keys) != Lisp_String)
1017     keys = wrong_type_argument (Qarrayp, keys);
1018
1019   Fdefine_key (map, keys, function);
1020   return Qnil;
1021 }
1022
1023 DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key,
1024   1, 1, "kUnset key globally: ",
1025   "Remove global binding of KEY.\n\
1026 KEY is a string representing a sequence of keystrokes.")
1027   (keys)
1028      Lisp_Object keys;
1029 {
1030   return Fglobal_set_key (keys, Qnil);
1031 }
1032
1033 DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1,
1034   "kUnset key locally: ",
1035   "Remove local binding of KEY.\n\
1036 KEY is a string representing a sequence of keystrokes.")
1037   (keys)
1038      Lisp_Object keys;
1039 {
1040   if (!NILP (current_buffer->keymap))
1041     Flocal_set_key (keys, Qnil);
1042   return Qnil;
1043 }
1044
1045 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0,
1046   "Define COMMAND as a prefix command.  COMMAND should be a symbol.\n\
1047 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1048 If a second optional argument MAPVAR is given, the map is stored as\n\
1049 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1050 as a function.")
1051   (name, mapvar)
1052      Lisp_Object name, mapvar;
1053 {
1054   Lisp_Object map;
1055   map = Fmake_sparse_keymap (Qnil);
1056   Ffset (name, map);
1057   if (!NILP (mapvar))
1058     Fset (mapvar, map);
1059   else
1060     Fset (name, map);
1061   return name;
1062 }
1063
1064 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1065   "Select KEYMAP as the global keymap.")
1066   (keymap)
1067      Lisp_Object keymap;
1068 {
1069   keymap = get_keymap (keymap);
1070   current_global_map = keymap;
1071   return Qnil;
1072 }
1073
1074 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1075   "Select KEYMAP as the local keymap.\n\
1076 If KEYMAP is nil, that means no local keymap.")
1077   (keymap)
1078      Lisp_Object keymap;
1079 {
1080   if (!NILP (keymap))
1081     keymap = get_keymap (keymap);
1082
1083   current_buffer->keymap = keymap;
1084
1085   return Qnil;
1086 }
1087
1088 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1089   "Return current buffer's local keymap, or nil if it has none.")
1090   ()
1091 {
1092   return current_buffer->keymap;
1093 }
1094
1095 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1096   "Return the current global keymap.")
1097   ()
1098 {
1099   return current_global_map;
1100 }
1101
1102 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1103   "Return a list of keymaps for the minor modes of the current buffer.")
1104   ()
1105 {
1106   Lisp_Object *maps;
1107   int nmaps = current_minor_maps (0, &maps);
1108
1109   return Flist (nmaps, maps);
1110 }
1111 \f
1112 /* Help functions for describing and documenting keymaps.               */
1113
1114 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1115   1, 2, 0,
1116   "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1117 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1118 KEYS starting from KEYMAP gets you to MAP.  These elements are ordered\n\
1119 so that the KEYS increase in length.  The first element is (\"\" . KEYMAP).\n\
1120 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1121 then the value includes only maps for prefixes that start with PREFIX.")
1122   (startmap, prefix)
1123      Lisp_Object startmap, prefix;
1124 {
1125   Lisp_Object maps, good_maps, tail;
1126   int prefixlen = 0;
1127
1128   if (!NILP (prefix))
1129     prefixlen = XINT (Flength (prefix));
1130
1131   maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1132                        get_keymap (startmap)),
1133                 Qnil);
1134
1135   /* For each map in the list maps,
1136      look at any other maps it points to,
1137      and stick them at the end if they are not already in the list.
1138
1139      This is a breadth-first traversal, where tail is the queue of
1140      nodes, and maps accumulates a list of all nodes visited.  */
1141
1142   for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr)
1143     {
1144       register Lisp_Object thisseq, thismap;
1145       Lisp_Object last;
1146       /* Does the current sequence end in the meta-prefix-char?  */
1147       int is_metized;
1148
1149       thisseq = Fcar (Fcar (tail));
1150       thismap = Fcdr (Fcar (tail));
1151       last = make_number (XINT (Flength (thisseq)) - 1);
1152       is_metized = (XINT (last) >= 0
1153                     && EQ (Faref (thisseq, last), meta_prefix_char));
1154
1155       for (; CONSP (thismap); thismap = XCONS (thismap)->cdr)
1156         {
1157           Lisp_Object elt;
1158
1159           elt = XCONS (thismap)->car;
1160
1161           QUIT;
1162
1163           if (XTYPE (elt) == Lisp_Vector)
1164             {
1165               register int i;
1166
1167               /* Vector keymap.  Scan all the elements.  */
1168               for (i = 0; i < XVECTOR (elt)->size; i++)
1169                 {
1170                   register Lisp_Object tem;
1171                   register Lisp_Object cmd;
1172
1173                   cmd = get_keyelt (XVECTOR (elt)->contents[i]);
1174                   if (NILP (cmd)) continue;
1175                   tem = Fkeymapp (cmd);
1176                   if (!NILP (tem))
1177                     {
1178                       cmd = get_keymap (cmd);
1179                       /* Ignore keymaps that are already added to maps.  */
1180                       tem = Frassq (cmd, maps);
1181                       if (NILP (tem))
1182                         {
1183                           /* If the last key in thisseq is meta-prefix-char,
1184                              turn it into a meta-ized keystroke.  We know
1185                              that the event we're about to append is an
1186                              ascii keystroke since we're processing a
1187                              keymap table.  */
1188                           if (is_metized)
1189                             {
1190                               int meta_bit = meta_modifier;
1191                               tem = Fcopy_sequence (thisseq);
1192
1193                               Faset (tem, last, make_number (i | meta_bit));
1194
1195                               /* This new sequence is the same length as
1196                                  thisseq, so stick it in the list right
1197                                  after this one.  */
1198                               XCONS (tail)->cdr
1199                                 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
1200                             }
1201                           else
1202                             {
1203                               tem = append_key (thisseq, make_number (i));
1204                               nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1205                             }
1206                         }
1207                     }
1208                 }
1209             }
1210           else if (CONSP (elt))
1211             {
1212               register Lisp_Object cmd, tem, filter;
1213
1214               cmd = get_keyelt (XCONS (elt)->cdr);
1215               /* Ignore definitions that aren't keymaps themselves.  */
1216               tem = Fkeymapp (cmd);
1217               if (!NILP (tem))
1218                 {
1219                   /* Ignore keymaps that have been seen already.  */
1220                   cmd = get_keymap (cmd);
1221                   tem = Frassq (cmd, maps);
1222                   if (NILP (tem))
1223                     {
1224                       /* Let elt be the event defined by this map entry.  */
1225                       elt = XCONS (elt)->car;
1226
1227                       /* If the last key in thisseq is meta-prefix-char, and
1228                          this entry is a binding for an ascii keystroke,
1229                          turn it into a meta-ized keystroke.  */
1230                       if (is_metized && XTYPE (elt) == Lisp_Int)
1231                         {
1232                           tem = Fcopy_sequence (thisseq);
1233                           Faset (tem, last,
1234                                  make_number (XINT (elt) | meta_modifier));
1235
1236                           /* This new sequence is the same length as
1237                              thisseq, so stick it in the list right
1238                              after this one.  */
1239                           XCONS (tail)->cdr
1240                             = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
1241                         }
1242                       else
1243                         nconc2 (tail,
1244                                 Fcons (Fcons (append_key (thisseq, elt), cmd),
1245                                        Qnil));
1246                     }
1247                 }
1248             }
1249         }
1250     }
1251
1252   if (NILP (prefix))
1253     return maps;
1254
1255   /* Now find just the maps whose access prefixes start with PREFIX.  */
1256
1257   good_maps = Qnil;
1258   for (; CONSP (maps); maps = XCONS (maps)->cdr)
1259     {
1260       Lisp_Object elt, thisseq;
1261       elt = XCONS (maps)->car;
1262       thisseq = XCONS (elt)->car;
1263       /* The access prefix must be at least as long as PREFIX,
1264          and the first elements must match those of PREFIX.  */
1265       if (XINT (Flength (thisseq)) >= prefixlen)
1266         {
1267           int i;
1268           for (i = 0; i < prefixlen; i++)
1269             {
1270               Lisp_Object i1;
1271               XFASTINT (i1) = i;
1272               if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1273                 break;
1274             }
1275           if (i == prefixlen)
1276             good_maps = Fcons (elt, good_maps);
1277         }
1278     }
1279
1280   return Fnreverse (good_maps);
1281 }
1282
1283 Lisp_Object Qsingle_key_description, Qkey_description;
1284
1285 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1286   "Return a pretty description of key-sequence KEYS.\n\
1287 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1288 spaces are put between sequence elements, etc.")
1289   (keys)
1290      Lisp_Object keys;
1291 {
1292   if (XTYPE (keys) == Lisp_String)
1293     {
1294       Lisp_Object vector;
1295       int i;
1296       vector = Fmake_vector (Flength (keys), Qnil);
1297       for (i = 0; i < XSTRING (keys)->size; i++)
1298         {
1299           if (XSTRING (keys)->data[i] & 0x80)
1300             XFASTINT (XVECTOR (vector)->contents[i])
1301               = meta_modifier | (XSTRING (keys)->data[i] & ~0x80);
1302           else
1303             XFASTINT (XVECTOR (vector)->contents[i])
1304               = XSTRING (keys)->data[i];
1305         }
1306       keys = vector;
1307     }
1308   return Fmapconcat (Qsingle_key_description, keys, build_string (" "));
1309 }
1310
1311 char *
1312 push_key_description (c, p)
1313      register unsigned int c;
1314      register char *p;
1315 {
1316   /* Clear all the meaningless bits above the meta bit.  */
1317   c &= meta_modifier | ~ - meta_modifier;
1318
1319   if (c & alt_modifier)
1320     {
1321       *p++ = 'A';
1322       *p++ = '-';
1323       c -= alt_modifier;
1324     }
1325   if (c & ctrl_modifier)
1326     {
1327       *p++ = 'C';
1328       *p++ = '-';
1329       c -= ctrl_modifier;
1330     }
1331   if (c & hyper_modifier)
1332     {
1333       *p++ = 'H';
1334       *p++ = '-';
1335       c -= hyper_modifier;
1336     }
1337   if (c & meta_modifier)
1338     {
1339       *p++ = 'M';
1340       *p++ = '-';
1341       c -= meta_modifier;
1342     }
1343   if (c & shift_modifier)
1344     {
1345       *p++ = 'S';
1346       *p++ = '-';
1347       c -= shift_modifier;
1348     }
1349   if (c & super_modifier)
1350     {
1351       *p++ = 's';
1352       *p++ = '-';
1353       c -= super_modifier;
1354     }
1355   if (c < 040)
1356     {
1357       if (c == 033)
1358         {
1359           *p++ = 'E';
1360           *p++ = 'S';
1361           *p++ = 'C';
1362         }
1363       else if (c == '\t')
1364         {
1365           *p++ = 'T';
1366           *p++ = 'A';
1367           *p++ = 'B';
1368         }
1369       else if (c == Ctl('J'))
1370         {
1371           *p++ = 'L';
1372           *p++ = 'F';
1373           *p++ = 'D';
1374         }
1375       else if (c == Ctl('M'))
1376         {
1377           *p++ = 'R';
1378           *p++ = 'E';
1379           *p++ = 'T';
1380         }
1381       else
1382         {
1383           *p++ = 'C';
1384           *p++ = '-';
1385           if (c > 0 && c <= Ctl ('Z'))
1386             *p++ = c + 0140;
1387           else
1388             *p++ = c + 0100;
1389         }
1390     }
1391   else if (c == 0177)
1392     {
1393       *p++ = 'D';
1394       *p++ = 'E';
1395       *p++ = 'L';
1396     }
1397   else if (c == ' ')
1398     {
1399       *p++ = 'S';
1400       *p++ = 'P';
1401       *p++ = 'C';
1402     }
1403   else if (c < 256)
1404     *p++ = c;
1405   else
1406     {
1407       *p++ = '\\';
1408       *p++ = (7 & (c >> 15)) + '0';
1409       *p++ = (7 & (c >> 12)) + '0';
1410       *p++ = (7 & (c >> 9)) + '0';
1411       *p++ = (7 & (c >> 6)) + '0';
1412       *p++ = (7 & (c >> 3)) + '0';
1413       *p++ = (7 & (c >> 0)) + '0';
1414     }
1415
1416   return p;
1417 }
1418
1419 DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
1420   "Return a pretty description of command character KEY.\n\
1421 Control characters turn into C-whatever, etc.")
1422   (key)
1423      Lisp_Object key;
1424 {
1425   char tem[20];
1426
1427   key = EVENT_HEAD (key);
1428
1429   switch (XTYPE (key))
1430     {
1431     case Lisp_Int:              /* Normal character */
1432       *push_key_description (XUINT (key), tem) = 0;
1433       return build_string (tem);
1434
1435     case Lisp_Symbol:           /* Function key or event-symbol */
1436       return Fsymbol_name (key);
1437
1438     default:
1439       error ("KEY must be an integer, cons, or symbol.");
1440     }
1441 }
1442
1443 char *
1444 push_text_char_description (c, p)
1445      register unsigned int c;
1446      register char *p;
1447 {
1448   if (c >= 0200)
1449     {
1450       *p++ = 'M';
1451       *p++ = '-';
1452       c -= 0200;
1453     }
1454   if (c < 040)
1455     {
1456       *p++ = '^';
1457       *p++ = c + 64;            /* 'A' - 1 */
1458     }
1459   else if (c == 0177)
1460     {
1461       *p++ = '^';
1462       *p++ = '?';
1463     }
1464   else
1465     *p++ = c;
1466   return p;
1467 }
1468
1469 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1470   "Return a pretty description of file-character CHAR.\n\
1471 Control characters turn into \"^char\", etc.")
1472   (chr)
1473      Lisp_Object chr;
1474 {
1475   char tem[6];
1476
1477   CHECK_NUMBER (chr, 0);
1478
1479   *push_text_char_description (XINT (chr) & 0377, tem) = 0;
1480
1481   return build_string (tem);
1482 }
1483
1484 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
1485    a meta bit.  */
1486 static int
1487 ascii_sequence_p (seq)
1488      Lisp_Object seq;
1489 {
1490   Lisp_Object i;
1491   int len = XINT (Flength (seq));
1492
1493   for (XFASTINT (i) = 0; XFASTINT (i) < len; XFASTINT (i)++)
1494     {
1495       Lisp_Object elt;
1496
1497       elt = Faref (seq, i);
1498
1499       if (XTYPE (elt) != Lisp_Int
1500           || (XUINT (elt) & ~CHAR_META) >= 0x80)
1501         return 0;
1502     }
1503
1504   return 1;
1505 }
1506
1507 \f
1508 /* where-is - finding a command in a set of keymaps.                    */
1509
1510 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
1511   "Return list of keys that invoke DEFINITION.\n\
1512 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
1513 If KEYMAP is nil, search all the currently active keymaps.\n\
1514 \n\
1515 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
1516 rather than a list of all possible key sequences.\n\
1517 If FIRSTONLY is t, avoid key sequences which use non-ASCII\n\
1518 keys and therefore may not be usable on ASCII terminals.  If FIRSTONLY\n\
1519 is the symbol `non-ascii', return the first binding found, no matter\n\
1520 what its components.\n\
1521 \n\
1522 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
1523 to other keymaps or slots.  This makes it possible to search for an\n\
1524 indirect definition itself.")
1525   (definition, keymap, firstonly, noindirect)
1526      Lisp_Object definition, keymap;
1527      Lisp_Object firstonly, noindirect;
1528 {
1529   register Lisp_Object maps;
1530   Lisp_Object found;
1531   int keymap_specified = !NILP (keymap);
1532
1533   if (! keymap_specified)
1534     {
1535 #ifdef USE_TEXT_PROPERTIES
1536       keymap = get_local_map (PT, current_buffer);
1537 #else
1538       keymap = current_buffer->keymap;
1539 #endif
1540     }
1541
1542   if (!NILP (keymap))
1543     maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil),
1544                    Faccessible_keymaps (get_keymap (current_global_map),
1545                                         Qnil));
1546   else
1547     maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
1548
1549   /* Put the minor mode keymaps on the front.  */
1550   if (! keymap_specified)
1551     {
1552       Lisp_Object minors;
1553       minors = Fnreverse (Fcurrent_minor_mode_maps ());
1554       while (!NILP (minors))
1555         {
1556           maps = nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors)->car),
1557                                               Qnil),
1558                          maps);
1559           minors = XCONS (minors)->cdr;
1560         }
1561     }
1562
1563   found = Qnil;
1564
1565   for (; !NILP (maps); maps = Fcdr (maps))
1566     {
1567       /* Key sequence to reach map, and the map that it reaches */
1568       register Lisp_Object this, map;
1569
1570       /* If Fcar (map) is a VECTOR, the current element within that vector.  */
1571       int i = 0;
1572
1573       /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1574          [M-CHAR] sequences, check if last character of the sequence
1575          is the meta-prefix char.  */
1576       Lisp_Object last;
1577       int last_is_meta;
1578
1579       this = Fcar (Fcar (maps));
1580       map  = Fcdr (Fcar (maps));
1581       last = make_number (XINT (Flength (this)) - 1);
1582       last_is_meta = (XINT (last) >= 0
1583                       && EQ (Faref (this, last), meta_prefix_char));
1584
1585       QUIT;
1586
1587       while (CONSP (map))
1588         {
1589           /* Because the code we want to run on each binding is rather
1590              large, we don't want to have two separate loop bodies for
1591              sparse keymap bindings and tables; we want to iterate one
1592              loop body over both keymap and vector bindings.
1593
1594              For this reason, if Fcar (map) is a vector, we don't
1595              advance map to the next element until i indicates that we
1596              have finished off the vector.  */
1597
1598           Lisp_Object elt, key, binding, sequence;
1599           elt = XCONS (map)->car;
1600
1601           QUIT;
1602
1603           /* Set key and binding to the current key and binding, and
1604              advance map and i to the next binding.  */
1605           if (XTYPE (elt) == Lisp_Vector)
1606             {
1607               /* In a vector, look at each element.  */
1608               binding = XVECTOR (elt)->contents[i];
1609               XFASTINT (key) = i;
1610               i++;
1611
1612               /* If we've just finished scanning a vector, advance map
1613                  to the next element, and reset i in anticipation of the
1614                  next vector we may find.  */
1615               if (i >= XVECTOR (elt)->size)
1616                 {
1617                   map = XCONS (map)->cdr;
1618                   i = 0;
1619                 }
1620             }
1621           else if (CONSP (elt))
1622             {
1623               key = Fcar (Fcar (map));
1624               binding = Fcdr (Fcar (map));
1625
1626               map = XCONS (map)->cdr;
1627             }
1628           else
1629             /* We want to ignore keymap elements that are neither
1630                vectors nor conses.  */
1631             {
1632               map = XCONS (map)->cdr;
1633               continue;
1634             }
1635
1636           /* Search through indirections unless that's not wanted.  */
1637           if (NILP (noindirect))
1638             binding = get_keyelt (binding);
1639
1640           /* End this iteration if this element does not match
1641              the target.  */
1642
1643           if (XTYPE (definition) == Lisp_Cons)
1644             {
1645               Lisp_Object tem;
1646               tem = Fequal (binding, definition);
1647               if (NILP (tem))
1648                 continue;
1649             }
1650           else
1651             if (!EQ (binding, definition))
1652               continue;
1653
1654           /* We have found a match.
1655              Construct the key sequence where we found it.  */
1656           if (XTYPE (key) == Lisp_Int && last_is_meta)
1657             {
1658               sequence = Fcopy_sequence (this);
1659               Faset (sequence, last, make_number (XINT (key) | meta_modifier));
1660             }
1661           else
1662             sequence = append_key (this, key);
1663
1664           /* Verify that this key binding is not shadowed by another
1665              binding for the same key, before we say it exists.
1666
1667              Mechanism: look for local definition of this key and if
1668              it is defined and does not match what we found then
1669              ignore this key.
1670
1671              Either nil or number as value from Flookup_key
1672              means undefined.  */
1673           if (keymap_specified)
1674             {
1675               binding = Flookup_key (keymap, sequence, Qnil);
1676               if (!NILP (binding) && XTYPE (binding) != Lisp_Int)
1677                 {
1678                   if (XTYPE (definition) == Lisp_Cons)
1679                     {
1680                       Lisp_Object tem;
1681                       tem = Fequal (binding, definition);
1682                       if (NILP (tem))
1683                         continue;
1684                     }
1685                   else
1686                     if (!EQ (binding, definition))
1687                       continue;
1688                 }
1689             }
1690           else
1691             {
1692               binding = Fkey_binding (sequence, Qnil);
1693               if (!EQ (binding, definition))
1694                 continue;
1695             }
1696
1697           /* It is a true unshadowed match.  Record it.  */
1698           found = Fcons (sequence, found);
1699
1700           /* If firstonly is Qnon_ascii, then we can return the first
1701              binding we find.  If firstonly is not Qnon_ascii but not
1702              nil, then we should return the first ascii-only binding
1703              we find.  */
1704           if (EQ (firstonly, Qnon_ascii))
1705             return sequence;
1706           else if (! NILP (firstonly) && ascii_sequence_p (sequence))
1707             return sequence;
1708         }
1709     }
1710
1711   found = Fnreverse (found);
1712
1713   /* firstonly may have been t, but we may have gone all the way through
1714      the keymaps without finding an all-ASCII key sequence.  So just
1715      return the best we could find.  */
1716   if (! NILP (firstonly))
1717     return Fcar (found);
1718
1719   return found;
1720 }
1721 \f
1722 /* describe-bindings - summarizing all the bindings in a set of keymaps.  */
1723
1724 DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
1725   "Show a list of all defined keys, and their definitions.\n\
1726 The list is put in a buffer, which is displayed.\n\
1727 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1728 then we display only bindings that start with that prefix.")
1729   (prefix)
1730      Lisp_Object prefix;
1731 {
1732   register Lisp_Object thisbuf;
1733   XSET (thisbuf, Lisp_Buffer, current_buffer);
1734   internal_with_output_to_temp_buffer ("*Help*",
1735                                        describe_buffer_bindings,
1736                                        Fcons (thisbuf, prefix));
1737   return Qnil;
1738 }
1739
1740 /* ARG is (BUFFER . PREFIX).  */
1741
1742 static Lisp_Object
1743 describe_buffer_bindings (arg)
1744      Lisp_Object arg;
1745 {
1746   Lisp_Object descbuf, prefix, shadow;
1747   register Lisp_Object start1, start2;
1748
1749   char *alternate_heading
1750     = "\
1751 Alternate Characters (use anywhere the nominal character is listed):\n\
1752 nominal         alternate\n\
1753 -------         ---------\n";
1754
1755   descbuf = XCONS (arg)->car;
1756   prefix = XCONS (arg)->cdr;
1757   shadow = Qnil;
1758
1759   Fset_buffer (Vstandard_output);
1760
1761   /* Report on alternates for keys.  */
1762   if (XTYPE (Vkeyboard_translate_table) == Lisp_String)
1763     {
1764       int c;
1765       unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
1766       int translate_len = XSTRING (Vkeyboard_translate_table)->size;
1767
1768       for (c = 0; c < translate_len; c++)
1769         if (translate[c] != c)
1770           {
1771             char buf[20];
1772             char *bufend;
1773
1774             if (alternate_heading)
1775               {
1776                 insert_string (alternate_heading);
1777                 alternate_heading = 0;
1778               }
1779
1780             bufend = push_key_description (translate[c], buf);
1781             insert (buf, bufend - buf);
1782             Findent_to (make_number (16), make_number (1));
1783             bufend = push_key_description (c, buf);
1784             insert (buf, bufend - buf);
1785
1786             insert ("\n", 1);
1787           }
1788
1789       insert ("\n", 1);
1790     }
1791
1792   {
1793     int i, nmaps;
1794     Lisp_Object *modes, *maps;
1795
1796     /* Temporarily switch to descbuf, so that we can get that buffer's
1797        minor modes correctly.  */
1798     Fset_buffer (descbuf);
1799     if (!NILP (Voverriding_local_map))
1800       nmaps = 0;
1801     else
1802       nmaps = current_minor_maps (&modes, &maps);
1803     Fset_buffer (Vstandard_output);
1804
1805     /* Print the minor mode maps.  */
1806     for (i = 0; i < nmaps; i++)
1807       {
1808         /* Tht title for a minor mode keymap
1809            is constructed at run time.
1810            We let describe_map_tree do the actual insertion
1811            because it takes care of other features when doing so.  */
1812         char *title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
1813         char *p = title;
1814
1815         if (XTYPE (modes[i]) == Lisp_Symbol)
1816           {
1817             *p++ = '`';
1818             bcopy (XSYMBOL (modes[i])->name->data, p,
1819                    XSYMBOL (modes[i])->name->size);
1820             p += XSYMBOL (modes[i])->name->size;
1821             *p++ = '\'';
1822           }
1823         else
1824           {
1825             bcopy ("Strangely Named", p, sizeof ("Strangely Named"));
1826             p += sizeof ("Strangely Named");
1827           }
1828         bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings"));
1829         p += sizeof (" Minor Mode Bindings");
1830         *p = 0;
1831
1832         describe_map_tree (maps[i], 0, shadow, prefix, title, 0);
1833         shadow = Fcons (maps[i], shadow);
1834       }
1835   }
1836
1837   /* Print the (major mode) local map.  */
1838   if (!NILP (Voverriding_local_map))
1839     start1 = Voverriding_local_map;
1840   else
1841     start1 = XBUFFER (descbuf)->keymap;
1842
1843   if (!NILP (start1))
1844     {
1845       describe_map_tree (start1, 0, shadow, prefix,
1846                          "Major Mode Bindings", 0);
1847       shadow = Fcons (start1, shadow);
1848     }
1849
1850   describe_map_tree (current_global_map, 0, shadow, prefix,
1851                      "Global Bindings", 0);
1852
1853   Fset_buffer (descbuf);
1854   return Qnil;
1855 }
1856
1857 /* Insert a desription of the key bindings in STARTMAP,
1858     followed by those of all maps reachable through STARTMAP.
1859    If PARTIAL is nonzero, omit certain "uninteresting" commands
1860     (such as `undefined').
1861    If SHADOW is non-nil, it is a list of maps;
1862     don't mention keys which would be shadowed by any of them.
1863    PREFIX, if non-nil, says mention only keys that start with PREFIX.
1864    TITLE, if not 0, is a string to insert at the beginning.
1865    TITLE should not end with a colon or a newline; we supply that.
1866    If NOMENU is not 0, then omit menu-bar commands.  */
1867
1868 void
1869 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu)
1870      Lisp_Object startmap, shadow, prefix;
1871      int partial;
1872      char *title;
1873      int nomenu;
1874 {
1875   Lisp_Object maps;
1876   struct gcpro gcpro1;
1877   int something = 0;
1878   char *key_heading
1879     = "\
1880 key             binding\n\
1881 ---             -------\n";
1882
1883   maps = Faccessible_keymaps (startmap, prefix);
1884   GCPRO1 (maps);
1885
1886   if (nomenu)
1887     {
1888       Lisp_Object list;
1889
1890       /* Delete from MAPS each element that is for the menu bar.  */
1891       for (list = maps; !NILP (list); list = XCONS (list)->cdr)
1892         {
1893           Lisp_Object elt, prefix, tem;
1894
1895           elt = Fcar (list);
1896           prefix = Fcar (elt);
1897           if (XVECTOR (prefix)->size >= 1)
1898             {
1899               tem = Faref (prefix, make_number (0));
1900               if (EQ (tem, Qmenu_bar))
1901                 maps = Fdelq (elt, maps);
1902             }
1903         }
1904     }
1905
1906   if (!NILP (maps))
1907     {
1908       if (title)
1909         {
1910           insert_string (title);
1911           if (!NILP (prefix))
1912             {
1913               insert_string (" Starting With ");
1914               insert1 (Fkey_description (prefix));
1915             }
1916           insert_string (":\n");
1917         }
1918       insert_string (key_heading);
1919       something = 1;
1920     }
1921
1922   for (; !NILP (maps); maps = Fcdr (maps))
1923     {
1924       register Lisp_Object elt, prefix, sub_shadows, tail;
1925
1926       elt = Fcar (maps);
1927       prefix = Fcar (elt);
1928
1929       sub_shadows = Qnil;
1930
1931       for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
1932         {
1933           Lisp_Object shmap;
1934
1935           shmap = XCONS (tail)->car;
1936
1937           /* If the sequence by which we reach this keymap is zero-length,
1938              then the shadow map for this keymap is just SHADOW.  */
1939           if ((XTYPE (prefix) == Lisp_String
1940                && XSTRING (prefix)->size == 0)
1941               || (XTYPE (prefix) == Lisp_Vector
1942                   && XVECTOR (prefix)->size == 0))
1943             ;
1944           /* If the sequence by which we reach this keymap actually has
1945              some elements, then the sequence's definition in SHADOW is
1946              what we should use.  */
1947           else
1948             {
1949               shmap = Flookup_key (shadow, Fcar (elt), Qt);
1950               if (XTYPE (shmap) == Lisp_Int)
1951                 shmap = Qnil;
1952             }
1953
1954           /* If shmap is not nil and not a keymap,
1955              it completely shadows this map, so don't
1956              describe this map at all.  */
1957           if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
1958             goto skip;
1959
1960           if (!NILP (shmap))
1961             sub_shadows = Fcons (shmap, sub_shadows);
1962         }
1963
1964       describe_map (Fcdr (elt), Fcar (elt), partial, sub_shadows);
1965
1966     skip: ;
1967     }
1968
1969   if (something)
1970     insert_string ("\n");
1971
1972   UNGCPRO;
1973 }
1974
1975 static void
1976 describe_command (definition)
1977      Lisp_Object definition;
1978 {
1979   register Lisp_Object tem1;
1980
1981   Findent_to (make_number (16), make_number (1));
1982
1983   if (XTYPE (definition) == Lisp_Symbol)
1984     {
1985       XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
1986       insert1 (tem1);
1987       insert_string ("\n");
1988     }
1989   else if (STRINGP (definition))
1990     insert_string ("Keyboard Macro\n");
1991   else
1992     {
1993       tem1 = Fkeymapp (definition);
1994       if (!NILP (tem1))
1995         insert_string ("Prefix Command\n");
1996       else
1997         insert_string ("??\n");
1998     }
1999 }
2000
2001 /* Describe the contents of map MAP, assuming that this map itself is
2002    reached by the sequence of prefix keys KEYS (a string or vector).
2003    PARTIAL, SHADOW is as in `describe_map_tree' above.  */
2004
2005 static void
2006 describe_map (map, keys, partial, shadow)
2007      Lisp_Object map, keys;
2008      int partial;
2009      Lisp_Object shadow;
2010 {
2011   register Lisp_Object keysdesc;
2012
2013   if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2014     {
2015       Lisp_Object tem;
2016       /* Call Fkey_description first, to avoid GC bug for the other string.  */
2017       tem = Fkey_description (keys);
2018       keysdesc = concat2 (tem, build_string (" "));
2019     }
2020   else
2021     keysdesc = Qnil;
2022
2023   describe_map_2 (map, keysdesc, describe_command, partial, shadow);
2024 }
2025
2026 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2027    Returns the first non-nil binding found in any of those maps.  */
2028
2029 static Lisp_Object
2030 shadow_lookup (shadow, key, flag)
2031      Lisp_Object shadow, key, flag;
2032 {
2033   Lisp_Object tail, value;
2034
2035   for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2036     {
2037       value = Flookup_key (XCONS (tail)->car, key, flag);
2038       if (!NILP (value))
2039         return value;
2040     }
2041   return Qnil;
2042 }
2043
2044 /* Insert a description of KEYMAP into the current buffer.  */
2045
2046 static void
2047 describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow)
2048      register Lisp_Object keymap;
2049      Lisp_Object elt_prefix;
2050      int (*elt_describer) ();
2051      int partial;
2052      Lisp_Object shadow;
2053 {
2054   Lisp_Object tail, definition, event;
2055   Lisp_Object tem;
2056   Lisp_Object suppress;
2057   Lisp_Object kludge;
2058   int first = 1;
2059   struct gcpro gcpro1, gcpro2, gcpro3;
2060
2061   if (partial)
2062     suppress = intern ("suppress-keymap");
2063
2064   /* This vector gets used to present single keys to Flookup_key.  Since
2065      that is done once per keymap element, we don't want to cons up a
2066      fresh vector every time.  */
2067   kludge = Fmake_vector (make_number (1), Qnil);
2068   definition = Qnil;
2069
2070   GCPRO3 (elt_prefix, definition, kludge);
2071
2072   for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = Fcdr (tail))
2073     {
2074       QUIT;
2075
2076       if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
2077         describe_vector (XCONS (tail)->car,
2078                          elt_prefix, elt_describer, partial, shadow);
2079       else
2080         {
2081           event = Fcar_safe (Fcar (tail));
2082           definition = get_keyelt (Fcdr_safe (Fcar (tail)));
2083
2084           /* Don't show undefined commands or suppressed commands.  */
2085           if (NILP (definition)) continue;
2086           if (XTYPE (definition) == Lisp_Symbol && partial)
2087             {
2088               tem = Fget (definition, suppress);
2089               if (!NILP (tem))
2090                 continue;
2091             }
2092
2093           /* Don't show a command that isn't really visible
2094              because a local definition of the same key shadows it.  */
2095
2096           XVECTOR (kludge)->contents[0] = event;
2097           if (!NILP (shadow))
2098             {
2099               tem = shadow_lookup (shadow, kludge, Qt);
2100               if (!NILP (tem)) continue;
2101             }
2102
2103           tem = Flookup_key (keymap, kludge, Qt);
2104           if (! EQ (tem, definition)) continue;
2105
2106           if (first)
2107             {
2108               insert ("\n", 1);
2109               first = 0;
2110             }
2111
2112           if (!NILP (elt_prefix))
2113             insert1 (elt_prefix);
2114
2115           /* THIS gets the string to describe the character EVENT.  */
2116           insert1 (Fsingle_key_description (event));
2117
2118           /* Print a description of the definition of this character.
2119              elt_describer will take care of spacing out far enough
2120              for alignment purposes.  */
2121           (*elt_describer) (definition);
2122         }
2123     }
2124
2125   UNGCPRO;
2126 }
2127
2128 static int
2129 describe_vector_princ (elt)
2130      Lisp_Object elt;
2131 {
2132   Findent_to (make_number (16), make_number (1));
2133   Fprinc (elt, Qnil);
2134   Fterpri (Qnil);
2135 }
2136
2137 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2138   "Insert a description of contents of VECTOR.\n\
2139 This is text showing the elements of vector matched against indices.")
2140   (vector)
2141      Lisp_Object vector;
2142 {
2143   int count = specpdl_ptr - specpdl;
2144
2145   specbind (Qstandard_output, Fcurrent_buffer ());
2146   CHECK_VECTOR (vector, 0);
2147   describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil);
2148
2149   return unbind_to (count, Qnil);
2150 }
2151
2152 describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
2153      register Lisp_Object vector;
2154      Lisp_Object elt_prefix;
2155      int (*elt_describer) ();
2156      int partial;
2157      Lisp_Object shadow;
2158 {
2159   Lisp_Object this;
2160   Lisp_Object dummy;
2161   Lisp_Object tem1, tem2;
2162   register int i;
2163   Lisp_Object suppress;
2164   Lisp_Object kludge;
2165   int first = 1;
2166   struct gcpro gcpro1, gcpro2, gcpro3;
2167
2168   tem1 = Qnil;
2169
2170   /* This vector gets used to present single keys to Flookup_key.  Since
2171      that is done once per vector element, we don't want to cons up a
2172      fresh vector every time.  */
2173   kludge = Fmake_vector (make_number (1), Qnil);
2174   GCPRO3 (elt_prefix, tem1, kludge);
2175
2176   if (partial)
2177     suppress = intern ("suppress-keymap");
2178
2179   for (i = 0; i < XVECTOR (vector)->size; i++)
2180     {
2181       QUIT;
2182       tem1 = get_keyelt (XVECTOR (vector)->contents[i]);
2183
2184       if (NILP (tem1)) continue;
2185
2186       /* Don't mention suppressed commands.  */
2187       if (XTYPE (tem1) == Lisp_Symbol && partial)
2188         {
2189           this = Fget (tem1, suppress);
2190           if (!NILP (this))
2191             continue;
2192         }
2193
2194       /* If this command in this map is shadowed by some other map,
2195          ignore it.  */
2196       if (!NILP (shadow))
2197         {
2198           Lisp_Object tem;
2199
2200           XVECTOR (kludge)->contents[0] = make_number (i);
2201           tem = shadow_lookup (shadow, kludge, Qt);
2202
2203           if (!NILP (tem)) continue;
2204         }
2205
2206       if (first)
2207         {
2208           insert ("\n", 1);
2209           first = 0;
2210         }
2211
2212       /* Output the prefix that applies to every entry in this map.  */
2213       if (!NILP (elt_prefix))
2214         insert1 (elt_prefix);
2215
2216       /* Get the string to describe the character I, and print it.  */
2217       XFASTINT (dummy) = i;
2218
2219       /* THIS gets the string to describe the character DUMMY.  */
2220       this = Fsingle_key_description (dummy);
2221       insert1 (this);
2222
2223       /* Find all consecutive characters that have the same definition.  */
2224       while (i + 1 < XVECTOR (vector)->size
2225              && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]),
2226                  EQ (tem2, tem1)))
2227         i++;
2228
2229       /* If we have a range of more than one character,
2230          print where the range reaches to.  */
2231
2232       if (i != XINT (dummy))
2233         {
2234           insert (" .. ", 4);
2235           if (!NILP (elt_prefix))
2236             insert1 (elt_prefix);
2237
2238           XFASTINT (dummy) = i;
2239           insert1 (Fsingle_key_description (dummy));
2240         }
2241
2242       /* Print a description of the definition of this character.
2243          elt_describer will take care of spacing out far enough
2244          for alignment purposes.  */
2245       (*elt_describer) (tem1);
2246     }
2247
2248   UNGCPRO;
2249 }
2250 \f
2251 /* Apropos - finding all symbols whose names match a regexp.            */
2252 Lisp_Object apropos_predicate;
2253 Lisp_Object apropos_accumulate;
2254
2255 static void
2256 apropos_accum (symbol, string)
2257      Lisp_Object symbol, string;
2258 {
2259   register Lisp_Object tem;
2260
2261   tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
2262   if (!NILP (tem) && !NILP (apropos_predicate))
2263     tem = call1 (apropos_predicate, symbol);
2264   if (!NILP (tem))
2265     apropos_accumulate = Fcons (symbol, apropos_accumulate);
2266 }
2267
2268 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
2269   "Show all symbols whose names contain match for REGEXP.\n\
2270 If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\
2271 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
2272 Return list of symbols found.")
2273   (string, pred)
2274      Lisp_Object string, pred;
2275 {
2276   struct gcpro gcpro1, gcpro2;
2277   CHECK_STRING (string, 0);
2278   apropos_predicate = pred;
2279   GCPRO2 (apropos_predicate, apropos_accumulate);
2280   apropos_accumulate = Qnil;
2281   map_obarray (Vobarray, apropos_accum, string);
2282   apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
2283   UNGCPRO;
2284   return apropos_accumulate;
2285 }
2286 \f
2287 syms_of_keymap ()
2288 {
2289   Lisp_Object tem;
2290
2291   Qkeymap = intern ("keymap");
2292   staticpro (&Qkeymap);
2293
2294 /* Initialize the keymaps standardly used.
2295    Each one is the value of a Lisp variable, and is also
2296    pointed to by a C variable */
2297
2298   global_map = Fcons (Qkeymap,
2299                       Fcons (Fmake_vector (make_number (0400), Qnil), Qnil));
2300   Fset (intern ("global-map"), global_map);
2301
2302   meta_map = Fmake_keymap (Qnil);
2303   Fset (intern ("esc-map"), meta_map);
2304   Ffset (intern ("ESC-prefix"), meta_map);
2305
2306   control_x_map = Fmake_keymap (Qnil);
2307   Fset (intern ("ctl-x-map"), control_x_map);
2308   Ffset (intern ("Control-X-prefix"), control_x_map);
2309
2310   DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
2311     "Default keymap to use when reading from the minibuffer.");
2312   Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
2313
2314   DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
2315     "Local keymap for the minibuffer when spaces are not allowed.");
2316   Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
2317
2318   DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
2319     "Local keymap for minibuffer input with completion.");
2320   Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
2321
2322   DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
2323     "Local keymap for minibuffer input with completion, for exact match.");
2324   Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
2325
2326   current_global_map = global_map;
2327
2328   DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
2329     "Alist of keymaps to use for minor modes.\n\
2330 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
2331 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
2332 If two active keymaps bind the same key, the keymap appearing earlier\n\
2333 in the list takes precedence.");
2334   Vminor_mode_map_alist = Qnil;
2335
2336   DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
2337   "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
2338 This allows Emacs to recognize function keys sent from ASCII\n\
2339 terminals at any point in a key sequence.\n\
2340 \n\
2341 The read-key-sequence function replaces subsequences bound by\n\
2342 function-key-map with their bindings.  When the current local and global\n\
2343 keymaps have no binding for the current key sequence but\n\
2344 function-key-map binds a suffix of the sequence to a vector or string,\n\
2345 read-key-sequence replaces the matching suffix with its binding, and\n\
2346 continues with the new sequence.\n\
2347 \n\
2348 For example, suppose function-key-map binds `ESC O P' to [f1].\n\
2349 Typing `ESC O P' to read-key-sequence would return [f1].  Typing\n\
2350 `C-x ESC O P' would return [?\\C-x f1].  If [f1] were a prefix\n\
2351 key, typing `ESC O P x' would return [f1 x].");
2352   Vfunction_key_map = Fmake_sparse_keymap (Qnil);
2353
2354   Qsingle_key_description = intern ("single-key-description");
2355   staticpro (&Qsingle_key_description);
2356
2357   Qkey_description = intern ("key-description");
2358   staticpro (&Qkey_description);
2359
2360   Qkeymapp = intern ("keymapp");
2361   staticpro (&Qkeymapp);
2362
2363   Qnon_ascii = intern ("non-ascii");
2364   staticpro (&Qnon_ascii);
2365
2366   defsubr (&Skeymapp);
2367   defsubr (&Smake_keymap);
2368   defsubr (&Smake_sparse_keymap);
2369   defsubr (&Scopy_keymap);
2370   defsubr (&Skey_binding);
2371   defsubr (&Slocal_key_binding);
2372   defsubr (&Sglobal_key_binding);
2373   defsubr (&Sminor_mode_key_binding);
2374   defsubr (&Sglobal_set_key);
2375   defsubr (&Slocal_set_key);
2376   defsubr (&Sdefine_key);
2377   defsubr (&Slookup_key);
2378   defsubr (&Sglobal_unset_key);
2379   defsubr (&Slocal_unset_key);
2380   defsubr (&Sdefine_prefix_command);
2381   defsubr (&Suse_global_map);
2382   defsubr (&Suse_local_map);
2383   defsubr (&Scurrent_local_map);
2384   defsubr (&Scurrent_global_map);
2385   defsubr (&Scurrent_minor_mode_maps);
2386   defsubr (&Saccessible_keymaps);
2387   defsubr (&Skey_description);
2388   defsubr (&Sdescribe_vector);
2389   defsubr (&Ssingle_key_description);
2390   defsubr (&Stext_char_description);
2391   defsubr (&Swhere_is_internal);
2392   defsubr (&Sdescribe_bindings);
2393   defsubr (&Sapropos_internal);
2394 }
2395
2396 keys_of_keymap ()
2397 {
2398   Lisp_Object tem;
2399
2400   initial_define_key (global_map, 033, "ESC-prefix");
2401   initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
2402 }