src/keymap.c

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