src/keymap.c

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