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