src/keymap.c

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