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

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