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     case Lisp_String:
1442       return key;
1443
1444     default:
1445       error ("KEY must be an integer, cons, string, or symbol.");
1446     }
1447 }
1448
1449 char *
1450 push_text_char_description (c, p)
1451      register unsigned int c;
1452      register char *p;
1453 {
1454   if (c >= 0200)
1455     {
1456       *p++ = 'M';
1457       *p++ = '-';
1458       c -= 0200;
1459     }
1460   if (c < 040)
1461     {
1462       *p++ = '^';
1463       *p++ = c + 64;            /* 'A' - 1 */
1464     }
1465   else if (c == 0177)
1466     {
1467       *p++ = '^';
1468       *p++ = '?';
1469     }
1470   else
1471     *p++ = c;
1472   return p;
1473 }
1474
1475 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1476   "Return a pretty description of file-character CHAR.\n\
1477 Control characters turn into \"^char\", etc.")
1478   (chr)
1479      Lisp_Object chr;
1480 {
1481   char tem[6];
1482
1483   CHECK_NUMBER (chr, 0);
1484
1485   *push_text_char_description (XINT (chr) & 0377, tem) = 0;
1486
1487   return build_string (tem);
1488 }
1489
1490 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
1491    a meta bit.  */
1492 static int
1493 ascii_sequence_p (seq)
1494      Lisp_Object seq;
1495 {
1496   Lisp_Object i;
1497   int len = XINT (Flength (seq));
1498
1499   for (XFASTINT (i) = 0; XFASTINT (i) < len; XFASTINT (i)++)
1500     {
1501       Lisp_Object elt;
1502
1503       elt = Faref (seq, i);
1504
1505       if (XTYPE (elt) != Lisp_Int
1506           || (XUINT (elt) & ~CHAR_META) >= 0x80)
1507         return 0;
1508     }
1509
1510   return 1;
1511 }
1512
1513 \f
1514 /* where-is - finding a command in a set of keymaps.                    */
1515
1516 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
1517   "Return list of keys that invoke DEFINITION.\n\
1518 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
1519 If KEYMAP is nil, search all the currently active keymaps.\n\
1520 \n\
1521 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
1522 rather than a list of all possible key sequences.\n\
1523 If FIRSTONLY is t, avoid key sequences which use non-ASCII\n\
1524 keys and therefore may not be usable on ASCII terminals.  If FIRSTONLY\n\
1525 is the symbol `non-ascii', return the first binding found, no matter\n\
1526 what its components.\n\
1527 \n\
1528 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
1529 to other keymaps or slots.  This makes it possible to search for an\n\
1530 indirect definition itself.")
1531   (definition, keymap, firstonly, noindirect)
1532      Lisp_Object definition, keymap;
1533      Lisp_Object firstonly, noindirect;
1534 {
1535   register Lisp_Object maps;
1536   Lisp_Object found;
1537   int keymap_specified = !NILP (keymap);
1538
1539   if (! keymap_specified)
1540     {
1541 #ifdef USE_TEXT_PROPERTIES
1542       keymap = get_local_map (PT, current_buffer);
1543 #else
1544       keymap = current_buffer->keymap;
1545 #endif
1546     }
1547
1548   if (!NILP (keymap))
1549     maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil),
1550                    Faccessible_keymaps (get_keymap (current_global_map),
1551                                         Qnil));
1552   else
1553     maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
1554
1555   /* Put the minor mode keymaps on the front.  */
1556   if (! keymap_specified)
1557     {
1558       Lisp_Object minors;
1559       minors = Fnreverse (Fcurrent_minor_mode_maps ());
1560       while (!NILP (minors))
1561         {
1562           maps = nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors)->car),
1563                                               Qnil),
1564                          maps);
1565           minors = XCONS (minors)->cdr;
1566         }
1567     }
1568
1569   found = Qnil;
1570
1571   for (; !NILP (maps); maps = Fcdr (maps))
1572     {
1573       /* Key sequence to reach map, and the map that it reaches */
1574       register Lisp_Object this, map;
1575
1576       /* If Fcar (map) is a VECTOR, the current element within that vector.  */
1577       int i = 0;
1578
1579       /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1580          [M-CHAR] sequences, check if last character of the sequence
1581          is the meta-prefix char.  */
1582       Lisp_Object last;
1583       int last_is_meta;
1584
1585       this = Fcar (Fcar (maps));
1586       map  = Fcdr (Fcar (maps));
1587       last = make_number (XINT (Flength (this)) - 1);
1588       last_is_meta = (XINT (last) >= 0
1589                       && EQ (Faref (this, last), meta_prefix_char));
1590
1591       QUIT;
1592
1593       while (CONSP (map))
1594         {
1595           /* Because the code we want to run on each binding is rather
1596              large, we don't want to have two separate loop bodies for
1597              sparse keymap bindings and tables; we want to iterate one
1598              loop body over both keymap and vector bindings.
1599
1600              For this reason, if Fcar (map) is a vector, we don't
1601              advance map to the next element until i indicates that we
1602              have finished off the vector.  */
1603
1604           Lisp_Object elt, key, binding, sequence;
1605           elt = XCONS (map)->car;
1606
1607           QUIT;
1608
1609           /* Set key and binding to the current key and binding, and
1610              advance map and i to the next binding.  */
1611           if (XTYPE (elt) == Lisp_Vector)
1612             {
1613               /* In a vector, look at each element.  */
1614               binding = XVECTOR (elt)->contents[i];
1615               XFASTINT (key) = i;
1616               i++;
1617
1618               /* If we've just finished scanning a vector, advance map
1619                  to the next element, and reset i in anticipation of the
1620                  next vector we may find.  */
1621               if (i >= XVECTOR (elt)->size)
1622                 {
1623                   map = XCONS (map)->cdr;
1624                   i = 0;
1625                 }
1626             }
1627           else if (CONSP (elt))
1628             {
1629               key = Fcar (Fcar (map));
1630               binding = Fcdr (Fcar (map));
1631
1632               map = XCONS (map)->cdr;
1633             }
1634           else
1635             /* We want to ignore keymap elements that are neither
1636                vectors nor conses.  */
1637             {
1638               map = XCONS (map)->cdr;
1639               continue;
1640             }
1641
1642           /* Search through indirections unless that's not wanted.  */
1643           if (NILP (noindirect))
1644             binding = get_keyelt (binding, 0);
1645
1646           /* End this iteration if this element does not match
1647              the target.  */
1648
1649           if (XTYPE (definition) == Lisp_Cons)
1650             {
1651               Lisp_Object tem;
1652               tem = Fequal (binding, definition);
1653               if (NILP (tem))
1654                 continue;
1655             }
1656           else
1657             if (!EQ (binding, definition))
1658               continue;
1659
1660           /* We have found a match.
1661              Construct the key sequence where we found it.  */
1662           if (XTYPE (key) == Lisp_Int && last_is_meta)
1663             {
1664               sequence = Fcopy_sequence (this);
1665               Faset (sequence, last, make_number (XINT (key) | meta_modifier));
1666             }
1667           else
1668             sequence = append_key (this, key);
1669
1670           /* Verify that this key binding is not shadowed by another
1671              binding for the same key, before we say it exists.
1672
1673              Mechanism: look for local definition of this key and if
1674              it is defined and does not match what we found then
1675              ignore this key.
1676
1677              Either nil or number as value from Flookup_key
1678              means undefined.  */
1679           if (keymap_specified)
1680             {
1681               binding = Flookup_key (keymap, sequence, Qnil);
1682               if (!NILP (binding) && XTYPE (binding) != Lisp_Int)
1683                 {
1684                   if (XTYPE (definition) == Lisp_Cons)
1685                     {
1686                       Lisp_Object tem;
1687                       tem = Fequal (binding, definition);
1688                       if (NILP (tem))
1689                         continue;
1690                     }
1691                   else
1692                     if (!EQ (binding, definition))
1693                       continue;
1694                 }
1695             }
1696           else
1697             {
1698               binding = Fkey_binding (sequence, Qnil);
1699               if (!EQ (binding, definition))
1700                 continue;
1701             }
1702
1703           /* It is a true unshadowed match.  Record it, unless it's already
1704              been seen (as could happen when inheriting keymaps).  */
1705           if (NILP (Fmember (sequence, found)))
1706             found = Fcons (sequence, found);
1707
1708           /* If firstonly is Qnon_ascii, then we can return the first
1709              binding we find.  If firstonly is not Qnon_ascii but not
1710              nil, then we should return the first ascii-only binding
1711              we find.  */
1712           if (EQ (firstonly, Qnon_ascii))
1713             return sequence;
1714           else if (! NILP (firstonly) && ascii_sequence_p (sequence))
1715             return sequence;
1716         }
1717     }
1718
1719   found = Fnreverse (found);
1720
1721   /* firstonly may have been t, but we may have gone all the way through
1722      the keymaps without finding an all-ASCII key sequence.  So just
1723      return the best we could find.  */
1724   if (! NILP (firstonly))
1725     return Fcar (found);
1726
1727   return found;
1728 }
1729 \f
1730 /* describe-bindings - summarizing all the bindings in a set of keymaps.  */
1731
1732 DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
1733   "Show a list of all defined keys, and their definitions.\n\
1734 The list is put in a buffer, which is displayed.\n\
1735 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1736 then we display only bindings that start with that prefix.")
1737   (prefix)
1738      Lisp_Object prefix;
1739 {
1740   register Lisp_Object thisbuf;
1741   XSET (thisbuf, Lisp_Buffer, current_buffer);
1742   internal_with_output_to_temp_buffer ("*Help*",
1743                                        describe_buffer_bindings,
1744                                        Fcons (thisbuf, prefix));
1745   return Qnil;
1746 }
1747
1748 /* ARG is (BUFFER . PREFIX).  */
1749
1750 static Lisp_Object
1751 describe_buffer_bindings (arg)
1752      Lisp_Object arg;
1753 {
1754   Lisp_Object descbuf, prefix, shadow;
1755   register Lisp_Object start1, start2;
1756
1757   char *alternate_heading
1758     = "\
1759 Alternate Characters (use anywhere the nominal character is listed):\n\
1760 nominal         alternate\n\
1761 -------         ---------\n";
1762
1763   descbuf = XCONS (arg)->car;
1764   prefix = XCONS (arg)->cdr;
1765   shadow = Qnil;
1766
1767   Fset_buffer (Vstandard_output);
1768
1769   /* Report on alternates for keys.  */
1770   if (XTYPE (Vkeyboard_translate_table) == Lisp_String)
1771     {
1772       int c;
1773       unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
1774       int translate_len = XSTRING (Vkeyboard_translate_table)->size;
1775
1776       for (c = 0; c < translate_len; c++)
1777         if (translate[c] != c)
1778           {
1779             char buf[20];
1780             char *bufend;
1781
1782             if (alternate_heading)
1783               {
1784                 insert_string (alternate_heading);
1785                 alternate_heading = 0;
1786               }
1787
1788             bufend = push_key_description (translate[c], buf);
1789             insert (buf, bufend - buf);
1790             Findent_to (make_number (16), make_number (1));
1791             bufend = push_key_description (c, buf);
1792             insert (buf, bufend - buf);
1793
1794             insert ("\n", 1);
1795           }
1796
1797       insert ("\n", 1);
1798     }
1799
1800   {
1801     int i, nmaps;
1802     Lisp_Object *modes, *maps;
1803
1804     /* Temporarily switch to descbuf, so that we can get that buffer's
1805        minor modes correctly.  */
1806     Fset_buffer (descbuf);
1807     if (!NILP (Voverriding_local_map))
1808       nmaps = 0;
1809     else
1810       nmaps = current_minor_maps (&modes, &maps);
1811     Fset_buffer (Vstandard_output);
1812
1813     /* Print the minor mode maps.  */
1814     for (i = 0; i < nmaps; i++)
1815       {
1816         /* The title for a minor mode keymap
1817            is constructed at run time.
1818            We let describe_map_tree do the actual insertion
1819            because it takes care of other features when doing so.  */
1820         char *title, *p;
1821
1822         if (XTYPE (modes[i]) == Lisp_Symbol)
1823           {
1824             p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
1825             *p++ = '`';
1826             bcopy (XSYMBOL (modes[i])->name->data, p,
1827                    XSYMBOL (modes[i])->name->size);
1828             p += XSYMBOL (modes[i])->name->size;
1829             *p++ = '\'';
1830           }
1831         else
1832           {
1833             p = title = (char *) alloca (40 + 20);
1834             bcopy ("Strangely Named", p, sizeof ("Strangely Named") - 1);
1835             p += sizeof ("Strangely Named") - 1;
1836           }
1837         bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
1838         p += sizeof (" Minor Mode Bindings") - 1;
1839         *p = 0;
1840
1841         describe_map_tree (maps[i], 0, shadow, prefix, title, 0);
1842         shadow = Fcons (maps[i], shadow);
1843       }
1844   }
1845
1846   /* Print the (major mode) local map.  */
1847   if (!NILP (Voverriding_local_map))
1848     start1 = Voverriding_local_map;
1849   else
1850     start1 = XBUFFER (descbuf)->keymap;
1851
1852   if (!NILP (start1))
1853     {
1854       describe_map_tree (start1, 0, shadow, prefix,
1855                          "Major Mode Bindings", 0);
1856       shadow = Fcons (start1, shadow);
1857     }
1858
1859   describe_map_tree (current_global_map, 0, shadow, prefix,
1860                      "Global Bindings", 0);
1861
1862   Fset_buffer (descbuf);
1863   return Qnil;
1864 }
1865
1866 /* Insert a desription of the key bindings in STARTMAP,
1867     followed by those of all maps reachable through STARTMAP.
1868    If PARTIAL is nonzero, omit certain "uninteresting" commands
1869     (such as `undefined').
1870    If SHADOW is non-nil, it is a list of maps;
1871     don't mention keys which would be shadowed by any of them.
1872    PREFIX, if non-nil, says mention only keys that start with PREFIX.
1873    TITLE, if not 0, is a string to insert at the beginning.
1874    TITLE should not end with a colon or a newline; we supply that.
1875    If NOMENU is not 0, then omit menu-bar commands.  */
1876
1877 void
1878 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu)
1879      Lisp_Object startmap, shadow, prefix;
1880      int partial;
1881      char *title;
1882      int nomenu;
1883 {
1884   Lisp_Object maps, seen, sub_shadows;
1885   struct gcpro gcpro1, gcpro2, gcpro3;
1886   int something = 0;
1887   char *key_heading
1888     = "\
1889 key             binding\n\
1890 ---             -------\n";
1891
1892   maps = Faccessible_keymaps (startmap, prefix);
1893   seen = Qnil;
1894   sub_shadows = Qnil;
1895   GCPRO3 (maps, seen, sub_shadows);
1896
1897   if (nomenu)
1898     {
1899       Lisp_Object list;
1900
1901       /* Delete from MAPS each element that is for the menu bar.  */
1902       for (list = maps; !NILP (list); list = XCONS (list)->cdr)
1903         {
1904           Lisp_Object elt, prefix, tem;
1905
1906           elt = Fcar (list);
1907           prefix = Fcar (elt);
1908           if (XVECTOR (prefix)->size >= 1)
1909             {
1910               tem = Faref (prefix, make_number (0));
1911               if (EQ (tem, Qmenu_bar))
1912                 maps = Fdelq (elt, maps);
1913             }
1914         }
1915     }
1916
1917   if (!NILP (maps))
1918     {
1919       if (title)
1920         {
1921           insert_string (title);
1922           if (!NILP (prefix))
1923             {
1924               insert_string (" Starting With ");
1925               insert1 (Fkey_description (prefix));
1926             }
1927           insert_string (":\n");
1928         }
1929       insert_string (key_heading);
1930       something = 1;
1931     }
1932
1933   for (; !NILP (maps); maps = Fcdr (maps))
1934     {
1935       register Lisp_Object elt, prefix, tail;
1936
1937       elt = Fcar (maps);
1938       prefix = Fcar (elt);
1939
1940       sub_shadows = Qnil;
1941
1942       for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
1943         {
1944           Lisp_Object shmap;
1945
1946           shmap = XCONS (tail)->car;
1947
1948           /* If the sequence by which we reach this keymap is zero-length,
1949              then the shadow map for this keymap is just SHADOW.  */
1950           if ((XTYPE (prefix) == Lisp_String
1951                && XSTRING (prefix)->size == 0)
1952               || (XTYPE (prefix) == Lisp_Vector
1953                   && XVECTOR (prefix)->size == 0))
1954             ;
1955           /* If the sequence by which we reach this keymap actually has
1956              some elements, then the sequence's definition in SHADOW is
1957              what we should use.  */
1958           else
1959             {
1960               shmap = Flookup_key (shmap, Fcar (elt), Qt);
1961               if (XTYPE (shmap) == Lisp_Int)
1962                 shmap = Qnil;
1963             }
1964
1965           /* If shmap is not nil and not a keymap,
1966              it completely shadows this map, so don't
1967              describe this map at all.  */
1968           if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
1969             goto skip;
1970
1971           if (!NILP (shmap))
1972             sub_shadows = Fcons (shmap, sub_shadows);
1973         }
1974
1975       describe_map (Fcdr (elt), Fcar (elt), describe_command,
1976                     partial, sub_shadows, &seen);
1977
1978     skip: ;
1979     }
1980
1981   if (something)
1982     insert_string ("\n");
1983
1984   UNGCPRO;
1985 }
1986
1987 static void
1988 describe_command (definition)
1989      Lisp_Object definition;
1990 {
1991   register Lisp_Object tem1;
1992
1993   Findent_to (make_number (16), make_number (1));
1994
1995   if (XTYPE (definition) == Lisp_Symbol)
1996     {
1997       XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
1998       insert1 (tem1);
1999       insert_string ("\n");
2000     }
2001   else if (STRINGP (definition))
2002     insert_string ("Keyboard Macro\n");
2003   else
2004     {
2005       tem1 = Fkeymapp (definition);
2006       if (!NILP (tem1))
2007         insert_string ("Prefix Command\n");
2008       else
2009         insert_string ("??\n");
2010     }
2011 }
2012
2013 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2014    Returns the first non-nil binding found in any of those maps.  */
2015
2016 static Lisp_Object
2017 shadow_lookup (shadow, key, flag)
2018      Lisp_Object shadow, key, flag;
2019 {
2020   Lisp_Object tail, value;
2021
2022   for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2023     {
2024       value = Flookup_key (XCONS (tail)->car, key, flag);
2025       if (!NILP (value))
2026         return value;
2027     }
2028   return Qnil;
2029 }
2030
2031 /* Describe the contents of map MAP, assuming that this map itself is
2032    reached by the sequence of prefix keys KEYS (a string or vector).
2033    PARTIAL, SHADOW are as in `describe_map_tree' above.  */
2034
2035 static void
2036 describe_map (map, keys, elt_describer, partial, shadow, seen)
2037      register Lisp_Object map;
2038      Lisp_Object keys;
2039      int (*elt_describer) ();
2040      int partial;
2041      Lisp_Object shadow;
2042      Lisp_Object *seen;
2043 {
2044   Lisp_Object elt_prefix;
2045   Lisp_Object tail, definition, event;
2046   Lisp_Object tem;
2047   Lisp_Object suppress;
2048   Lisp_Object kludge;
2049   int first = 1;
2050   struct gcpro gcpro1, gcpro2, gcpro3;
2051
2052   if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2053     {
2054       /* Call Fkey_description first, to avoid GC bug for the other string.  */
2055       tem = Fkey_description (keys);
2056       elt_prefix = concat2 (tem, build_string (" "));
2057     }
2058   else
2059     elt_prefix = Qnil;
2060
2061   if (partial)
2062     suppress = intern ("suppress-keymap");
2063
2064   /* This vector gets used to present single keys to Flookup_key.  Since
2065      that is done once per keymap element, we don't want to cons up a
2066      fresh vector every time.  */
2067   kludge = Fmake_vector (make_number (1), Qnil);
2068   definition = Qnil;
2069
2070   GCPRO3 (elt_prefix, definition, kludge);
2071
2072   for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr)
2073     {
2074       QUIT;
2075
2076       if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
2077         describe_vector (XCONS (tail)->car,
2078                          elt_prefix, elt_describer, partial, shadow);
2079       else if (CONSP (XCONS (tail)->car))
2080         {
2081           event = XCONS (XCONS (tail)->car)->car;
2082           definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0);
2083
2084           /* Don't show undefined commands or suppressed commands.  */
2085           if (NILP (definition)) continue;
2086           if (XTYPE (definition) == Lisp_Symbol && partial)
2087             {
2088               tem = Fget (definition, suppress);
2089               if (!NILP (tem))
2090                 continue;
2091             }
2092
2093           /* Don't show a command that isn't really visible
2094              because a local definition of the same key shadows it.  */
2095
2096           XVECTOR (kludge)->contents[0] = event;
2097           if (!NILP (shadow))
2098             {
2099               tem = shadow_lookup (shadow, kludge, Qt);
2100               if (!NILP (tem)) continue;
2101             }
2102
2103           tem = Flookup_key (map, kludge, Qt);
2104           if (! EQ (tem, definition)) continue;
2105
2106           if (first)
2107             {
2108               insert ("\n", 1);
2109               first = 0;
2110             }
2111
2112           if (!NILP (elt_prefix))
2113             insert1 (elt_prefix);
2114
2115           /* THIS gets the string to describe the character EVENT.  */
2116           insert1 (Fsingle_key_description (event));
2117
2118           /* Print a description of the definition of this character.
2119              elt_describer will take care of spacing out far enough
2120              for alignment purposes.  */
2121           (*elt_describer) (definition);
2122         }
2123       else if (EQ (XCONS (tail)->car, Qkeymap))
2124         {
2125           /* The same keymap might be in the structure twice, if we're
2126              using an inherited keymap.  So skip anything we've already
2127              encountered.  */
2128           tem = Fassq (tail, *seen);
2129           if (CONSP (tem) && Fequal (XCONS (tem)->car, keys))
2130             break;
2131           *seen = Fcons (Fcons (tail, keys), *seen);
2132         }
2133     }
2134
2135   UNGCPRO;
2136 }
2137
2138 static int
2139 describe_vector_princ (elt)
2140      Lisp_Object elt;
2141 {
2142   Findent_to (make_number (16), make_number (1));
2143   Fprinc (elt, Qnil);
2144   Fterpri (Qnil);
2145 }
2146
2147 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2148   "Insert a description of contents of VECTOR.\n\
2149 This is text showing the elements of vector matched against indices.")
2150   (vector)
2151      Lisp_Object vector;
2152 {
2153   int count = specpdl_ptr - specpdl;
2154
2155   specbind (Qstandard_output, Fcurrent_buffer ());
2156   CHECK_VECTOR (vector, 0);
2157   describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil);
2158
2159   return unbind_to (count, Qnil);
2160 }
2161
2162 describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
2163      register Lisp_Object vector;
2164      Lisp_Object elt_prefix;
2165      int (*elt_describer) ();
2166      int partial;
2167      Lisp_Object shadow;
2168 {
2169   Lisp_Object this;
2170   Lisp_Object dummy;
2171   Lisp_Object tem1, tem2;
2172   register int i;
2173   Lisp_Object suppress;
2174   Lisp_Object kludge;
2175   int first = 1;
2176   struct gcpro gcpro1, gcpro2, gcpro3;
2177
2178   tem1 = Qnil;
2179
2180   /* This vector gets used to present single keys to Flookup_key.  Since
2181      that is done once per vector element, we don't want to cons up a
2182      fresh vector every time.  */
2183   kludge = Fmake_vector (make_number (1), Qnil);
2184   GCPRO3 (elt_prefix, tem1, kludge);
2185
2186   if (partial)
2187     suppress = intern ("suppress-keymap");
2188
2189   for (i = 0; i < XVECTOR (vector)->size; i++)
2190     {
2191       QUIT;
2192       tem1 = get_keyelt (XVECTOR (vector)->contents[i], 0);
2193
2194       if (NILP (tem1)) continue;
2195
2196       /* Don't mention suppressed commands.  */
2197       if (XTYPE (tem1) == Lisp_Symbol && partial)
2198         {
2199           this = Fget (tem1, suppress);
2200           if (!NILP (this))
2201             continue;
2202         }
2203
2204       /* If this command in this map is shadowed by some other map,
2205          ignore it.  */
2206       if (!NILP (shadow))
2207         {
2208           Lisp_Object tem;
2209
2210           XVECTOR (kludge)->contents[0] = make_number (i);
2211           tem = shadow_lookup (shadow, kludge, Qt);
2212
2213           if (!NILP (tem)) continue;
2214         }
2215
2216       if (first)
2217         {
2218           insert ("\n", 1);
2219           first = 0;
2220         }
2221
2222       /* Output the prefix that applies to every entry in this map.  */
2223       if (!NILP (elt_prefix))
2224         insert1 (elt_prefix);
2225
2226       /* Get the string to describe the character I, and print it.  */
2227       XFASTINT (dummy) = i;
2228
2229       /* THIS gets the string to describe the character DUMMY.  */
2230       this = Fsingle_key_description (dummy);
2231       insert1 (this);
2232
2233       /* Find all consecutive characters that have the same definition.  */
2234       while (i + 1 < XVECTOR (vector)->size
2235              && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1], 0),
2236                  EQ (tem2, tem1)))
2237         i++;
2238
2239       /* If we have a range of more than one character,
2240          print where the range reaches to.  */
2241
2242       if (i != XINT (dummy))
2243         {
2244           insert (" .. ", 4);
2245           if (!NILP (elt_prefix))
2246             insert1 (elt_prefix);
2247
2248           XFASTINT (dummy) = i;
2249           insert1 (Fsingle_key_description (dummy));
2250         }
2251
2252       /* Print a description of the definition of this character.
2253          elt_describer will take care of spacing out far enough
2254          for alignment purposes.  */
2255       (*elt_describer) (tem1);
2256     }
2257
2258   UNGCPRO;
2259 }
2260 \f
2261 /* Apropos - finding all symbols whose names match a regexp.            */
2262 Lisp_Object apropos_predicate;
2263 Lisp_Object apropos_accumulate;
2264
2265 static void
2266 apropos_accum (symbol, string)
2267      Lisp_Object symbol, string;
2268 {
2269   register Lisp_Object tem;
2270
2271   tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
2272   if (!NILP (tem) && !NILP (apropos_predicate))
2273     tem = call1 (apropos_predicate, symbol);
2274   if (!NILP (tem))
2275     apropos_accumulate = Fcons (symbol, apropos_accumulate);
2276 }
2277
2278 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
2279   "Show all symbols whose names contain match for REGEXP.\n\
2280 If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\
2281 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
2282 Return list of symbols found.")
2283   (string, pred)
2284      Lisp_Object string, pred;
2285 {
2286   struct gcpro gcpro1, gcpro2;
2287   CHECK_STRING (string, 0);
2288   apropos_predicate = pred;
2289   GCPRO2 (apropos_predicate, apropos_accumulate);
2290   apropos_accumulate = Qnil;
2291   map_obarray (Vobarray, apropos_accum, string);
2292   apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
2293   UNGCPRO;
2294   return apropos_accumulate;
2295 }
2296 \f
2297 syms_of_keymap ()
2298 {
2299   Lisp_Object tem;
2300
2301   Qkeymap = intern ("keymap");
2302   staticpro (&Qkeymap);
2303
2304 /* Initialize the keymaps standardly used.
2305    Each one is the value of a Lisp variable, and is also
2306    pointed to by a C variable */
2307
2308   global_map = Fcons (Qkeymap,
2309                       Fcons (Fmake_vector (make_number (0400), Qnil), Qnil));
2310   Fset (intern ("global-map"), global_map);
2311
2312   meta_map = Fmake_keymap (Qnil);
2313   Fset (intern ("esc-map"), meta_map);
2314   Ffset (intern ("ESC-prefix"), meta_map);
2315
2316   control_x_map = Fmake_keymap (Qnil);
2317   Fset (intern ("ctl-x-map"), control_x_map);
2318   Ffset (intern ("Control-X-prefix"), control_x_map);
2319
2320   DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
2321     "Default keymap to use when reading from the minibuffer.");
2322   Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
2323
2324   DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
2325     "Local keymap for the minibuffer when spaces are not allowed.");
2326   Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
2327
2328   DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
2329     "Local keymap for minibuffer input with completion.");
2330   Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
2331
2332   DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
2333     "Local keymap for minibuffer input with completion, for exact match.");
2334   Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
2335
2336   current_global_map = global_map;
2337
2338   DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
2339     "Alist of keymaps to use for minor modes.\n\
2340 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
2341 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
2342 If two active keymaps bind the same key, the keymap appearing earlier\n\
2343 in the list takes precedence.");
2344   Vminor_mode_map_alist = Qnil;
2345
2346   DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
2347   "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
2348 This allows Emacs to recognize function keys sent from ASCII\n\
2349 terminals at any point in a key sequence.\n\
2350 \n\
2351 The read-key-sequence function replaces subsequences bound by\n\
2352 function-key-map with their bindings.  When the current local and global\n\
2353 keymaps have no binding for the current key sequence but\n\
2354 function-key-map binds a suffix of the sequence to a vector or string,\n\
2355 read-key-sequence replaces the matching suffix with its binding, and\n\
2356 continues with the new sequence.\n\
2357 \n\
2358 For example, suppose function-key-map binds `ESC O P' to [f1].\n\
2359 Typing `ESC O P' to read-key-sequence would return [f1].  Typing\n\
2360 `C-x ESC O P' would return [?\\C-x f1].  If [f1] were a prefix\n\
2361 key, typing `ESC O P x' would return [f1 x].");
2362   Vfunction_key_map = Fmake_sparse_keymap (Qnil);
2363
2364   Qsingle_key_description = intern ("single-key-description");
2365   staticpro (&Qsingle_key_description);
2366
2367   Qkey_description = intern ("key-description");
2368   staticpro (&Qkey_description);
2369
2370   Qkeymapp = intern ("keymapp");
2371   staticpro (&Qkeymapp);
2372
2373   Qnon_ascii = intern ("non-ascii");
2374   staticpro (&Qnon_ascii);
2375
2376   defsubr (&Skeymapp);
2377   defsubr (&Smake_keymap);
2378   defsubr (&Smake_sparse_keymap);
2379   defsubr (&Scopy_keymap);
2380   defsubr (&Skey_binding);
2381   defsubr (&Slocal_key_binding);
2382   defsubr (&Sglobal_key_binding);
2383   defsubr (&Sminor_mode_key_binding);
2384   defsubr (&Sglobal_set_key);
2385   defsubr (&Slocal_set_key);
2386   defsubr (&Sdefine_key);
2387   defsubr (&Slookup_key);
2388   defsubr (&Sglobal_unset_key);
2389   defsubr (&Slocal_unset_key);
2390   defsubr (&Sdefine_prefix_command);
2391   defsubr (&Suse_global_map);
2392   defsubr (&Suse_local_map);
2393   defsubr (&Scurrent_local_map);
2394   defsubr (&Scurrent_global_map);
2395   defsubr (&Scurrent_minor_mode_maps);
2396   defsubr (&Saccessible_keymaps);
2397   defsubr (&Skey_description);
2398   defsubr (&Sdescribe_vector);
2399   defsubr (&Ssingle_key_description);
2400   defsubr (&Stext_char_description);
2401   defsubr (&Swhere_is_internal);
2402   defsubr (&Sdescribe_bindings);
2403   defsubr (&Sapropos_internal);
2404 }
2405
2406 keys_of_keymap ()
2407 {
2408   Lisp_Object tem;
2409
2410   initial_define_key (global_map, 033, "ESC-prefix");
2411   initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
2412 }