src/keymap.c

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