src/keymap.c

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