src/keymap.c

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