src/keymap.c

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