code.delx.au - gnu-emacs/blob - src/keymap.c

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