src/keymap.c

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