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