src/keymap.c

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