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