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