src/keymap.c

   1 /* Manipulation of keymaps
   2    Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1998, 1999, 2000,
   3      2001, 2004, 2005  Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22
  23 #include <config.h>
  24 #include <stdio.h>
  25 #include "lisp.h"
  26 #include "commands.h"
  27 #include "buffer.h"
  28 #include "charset.h"
  29 #include "keyboard.h"
  30 #include "termhooks.h"
  31 #include "blockinput.h"
  32 #include "puresize.h"
  33 #include "intervals.h"
  34 #include "keymap.h"
  35
  36 /* The number of elements in keymap vectors.  */
  37 #define DENSE_TABLE_SIZE (0200)
  38
  39 /* Actually allocate storage for these variables */
  40
  41 Lisp_Object current_global_map; /* Current global keymap */
  42
  43 Lisp_Object global_map;         /* default global key bindings */
  44
  45 Lisp_Object meta_map;           /* The keymap used for globally bound
  46                                    ESC-prefixed default commands */
  47
  48 Lisp_Object control_x_map;      /* The keymap used for globally bound
  49                                    C-x-prefixed default commands */
  50
  51 /* was MinibufLocalMap */
  52 Lisp_Object Vminibuffer_local_map;
  53                                 /* The keymap used by the minibuf for local
  54                                    bindings when spaces are allowed in the
  55                                    minibuf */
  56
  57 /* was MinibufLocalNSMap */
  58 Lisp_Object Vminibuffer_local_ns_map;
  59                                 /* The keymap used by the minibuf for local
  60                                    bindings when spaces are not encouraged
  61                                    in the minibuf */
  62
  63 /* keymap used for minibuffers when doing completion */
  64 /* was MinibufLocalCompletionMap */
  65 Lisp_Object Vminibuffer_local_completion_map;
  66
  67 /* keymap used for minibuffers when doing completion and require a match */
  68 /* was MinibufLocalMustMatchMap */
  69 Lisp_Object Vminibuffer_local_must_match_map;
  70
  71 /* Alist of minor mode variables and keymaps.  */
  72 Lisp_Object Vminor_mode_map_alist;
  73
  74 /* Alist of major-mode-specific overrides for
  75    minor mode variables and keymaps.  */
  76 Lisp_Object Vminor_mode_overriding_map_alist;
  77
  78 /* List of emulation mode keymap alists.  */
  79 Lisp_Object Vemulation_mode_map_alists;
  80
  81 /* Keymap mapping ASCII function key sequences onto their preferred forms.
  82    Initialized by the terminal-specific lisp files.  See DEFVAR for more
  83    documentation.  */
  84 Lisp_Object Vfunction_key_map;
  85
  86 /* Keymap mapping ASCII function key sequences onto their preferred forms.  */
  87 Lisp_Object Vkey_translation_map;
  88
  89 /* A list of all commands given new bindings since a certain time
  90    when nil was stored here.
  91    This is used to speed up recomputation of menu key equivalents
  92    when Emacs starts up.   t means don't record anything here.  */
  93 Lisp_Object Vdefine_key_rebound_commands;
  94
  95 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
  96
  97 /* Alist of elements like (DEL . "\d").  */
  98 static Lisp_Object exclude_keys;
  99
 100 /* Pre-allocated 2-element vector for Fcommand_remapping to use.  */
 101 static Lisp_Object command_remapping_vector;
 102
 103 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
 104    in a string key sequence is equivalent to prefixing with this
 105    character.  */
 106 extern Lisp_Object meta_prefix_char;
 107
 108 extern Lisp_Object Voverriding_local_map;
 109
 110 /* Hash table used to cache a reverse-map to speed up calls to where-is.  */
 111 static Lisp_Object where_is_cache;
 112 /* Which keymaps are reverse-stored in the cache.  */
 113 static Lisp_Object where_is_cache_keymaps;
 114
 115 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 116 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 117
 118 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
 119 static void describe_command P_ ((Lisp_Object, Lisp_Object));
 120 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
 121 static void describe_map P_ ((Lisp_Object, Lisp_Object,
 122                               void (*) P_ ((Lisp_Object, Lisp_Object)),
 123                               int, Lisp_Object, Lisp_Object*, int, int));
 124 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
 125                                  void (*) (Lisp_Object, Lisp_Object), int,
 126                                  Lisp_Object, Lisp_Object, int *,
 127                                  int, int, int));
 128 static void silly_event_symbol_error P_ ((Lisp_Object));
 129 \f
 130 /* Keymap object support - constructors and predicates.                 */
 131
 132 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
 133        doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
 134 CHARTABLE is a char-table that holds the bindings for all characters
 135 without modifiers.  All entries in it are initially nil, meaning
 136 "command undefined".  ALIST is an assoc-list which holds bindings for
 137 function keys, mouse events, and any other things that appear in the
 138 input stream.  Initially, ALIST is nil.
 139
 140 The optional arg STRING supplies a menu name for the keymap
 141 in case you use it as a menu with `x-popup-menu'.  */)
 142      (string)
 143      Lisp_Object string;
 144 {
 145   Lisp_Object tail;
 146   if (!NILP (string))
 147     tail = Fcons (string, Qnil);
 148   else
 149     tail = Qnil;
 150   return Fcons (Qkeymap,
 151                 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
 152 }
 153
 154 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
 155        doc: /* Construct and return a new sparse keymap.
 156 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
 157 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
 158 which binds the function key or mouse event SYMBOL to DEFINITION.
 159 Initially the alist is nil.
 160
 161 The optional arg STRING supplies a menu name for the keymap
 162 in case you use it as a menu with `x-popup-menu'.  */)
 163      (string)
 164      Lisp_Object string;
 165 {
 166   if (!NILP (string))
 167     return Fcons (Qkeymap, Fcons (string, Qnil));
 168   return Fcons (Qkeymap, Qnil);
 169 }
 170
 171 /* This function is used for installing the standard key bindings
 172    at initialization time.
 173
 174    For example:
 175
 176    initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");  */
 177
 178 void
 179 initial_define_key (keymap, key, defname)
 180      Lisp_Object keymap;
 181      int key;
 182      char *defname;
 183 {
 184   store_in_keymap (keymap, make_number (key), intern (defname));
 185 }
 186
 187 void
 188 initial_define_lispy_key (keymap, keyname, defname)
 189      Lisp_Object keymap;
 190      char *keyname;
 191      char *defname;
 192 {
 193   store_in_keymap (keymap, intern (keyname), intern (defname));
 194 }
 195
 196 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
 197        doc: /* Return t if OBJECT is a keymap.
 198
 199 A keymap is a list (keymap . ALIST),
 200 or a symbol whose function definition is itself a keymap.
 201 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
 202 a vector of densely packed bindings for small character codes
 203 is also allowed as an element.  */)
 204      (object)
 205      Lisp_Object object;
 206 {
 207   return (KEYMAPP (object) ? Qt : Qnil);
 208 }
 209
 210 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
 211        doc: /* Return the prompt-string of a keymap MAP.
 212 If non-nil, the prompt is shown in the echo-area
 213 when reading a key-sequence to be looked-up in this keymap.  */)
 214      (map)
 215      Lisp_Object map;
 216 {
 217   map = get_keymap (map, 0, 0);
 218   while (CONSP (map))
 219     {
 220       Lisp_Object tem = XCAR (map);
 221       if (STRINGP (tem))
 222         return tem;
 223       map = XCDR (map);
 224     }
 225   return Qnil;
 226 }
 227
 228 /* Check that OBJECT is a keymap (after dereferencing through any
 229    symbols).  If it is, return it.
 230
 231    If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
 232    is an autoload form, do the autoload and try again.
 233    If AUTOLOAD is nonzero, callers must assume GC is possible.
 234
 235    If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
 236    is zero as well), return Qt.
 237
 238    ERROR controls how we respond if OBJECT isn't a keymap.
 239    If ERROR is non-zero, signal an error; otherwise, just return Qnil.
 240
 241    Note that most of the time, we don't want to pursue autoloads.
 242    Functions like Faccessible_keymaps which scan entire keymap trees
 243    shouldn't load every autoloaded keymap.  I'm not sure about this,
 244    but it seems to me that only read_key_sequence, Flookup_key, and
 245    Fdefine_key should cause keymaps to be autoloaded.
 246
 247    This function can GC when AUTOLOAD is non-zero, because it calls
 248    do_autoload which can GC.  */
 249
 250 Lisp_Object
 251 get_keymap (object, error, autoload)
 252      Lisp_Object object;
 253      int error, autoload;
 254 {
 255   Lisp_Object tem;
 256
 257  autoload_retry:
 258   if (NILP (object))
 259     goto end;
 260   if (CONSP (object) && EQ (XCAR (object), Qkeymap))
 261     return object;
 262
 263   tem = indirect_function (object);
 264   if (CONSP (tem))
 265     {
 266       if (EQ (XCAR (tem), Qkeymap))
 267         return tem;
 268
 269       /* Should we do an autoload?  Autoload forms for keymaps have
 270          Qkeymap as their fifth element.  */
 271       if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
 272           && SYMBOLP (object))
 273         {
 274           Lisp_Object tail;
 275
 276           tail = Fnth (make_number (4), tem);
 277           if (EQ (tail, Qkeymap))
 278             {
 279               if (autoload)
 280                 {
 281                   struct gcpro gcpro1, gcpro2;
 282
 283                   GCPRO2 (tem, object);
 284                   do_autoload (tem, object);
 285                   UNGCPRO;
 286
 287                   goto autoload_retry;
 288                 }
 289               else
 290                 return Qt;
 291             }
 292         }
 293     }
 294
 295  end:
 296   if (error)
 297     wrong_type_argument (Qkeymapp, object);
 298   return Qnil;
 299 }
 300 \f
 301 /* Return the parent map of KEYMAP, or nil if it has none.
 302    We assume that KEYMAP is a valid keymap.  */
 303
 304 Lisp_Object
 305 keymap_parent (keymap, autoload)
 306      Lisp_Object keymap;
 307      int autoload;
 308 {
 309   Lisp_Object list;
 310
 311   keymap = get_keymap (keymap, 1, autoload);
 312
 313   /* Skip past the initial element `keymap'.  */
 314   list = XCDR (keymap);
 315   for (; CONSP (list); list = XCDR (list))
 316     {
 317       /* See if there is another `keymap'.  */
 318       if (KEYMAPP (list))
 319         return list;
 320     }
 321
 322   return get_keymap (list, 0, autoload);
 323 }
 324
 325 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
 326        doc: /* Return the parent keymap of KEYMAP.  */)
 327      (keymap)
 328      Lisp_Object keymap;
 329 {
 330   return keymap_parent (keymap, 1);
 331 }
 332
 333 /* Check whether MAP is one of MAPS parents.  */
 334 int
 335 keymap_memberp (map, maps)
 336      Lisp_Object map, maps;
 337 {
 338   if (NILP (map)) return 0;
 339   while (KEYMAPP (maps) && !EQ (map, maps))
 340     maps = keymap_parent (maps, 0);
 341   return (EQ (map, maps));
 342 }
 343
 344 /* Set the parent keymap of MAP to PARENT.  */
 345
 346 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
 347        doc: /* Modify KEYMAP to set its parent map to PARENT.
 348 Return PARENT.  PARENT should be nil or another keymap.  */)
 349      (keymap, parent)
 350      Lisp_Object keymap, parent;
 351 {
 352   Lisp_Object list, prev;
 353   struct gcpro gcpro1, gcpro2;
 354   int i;
 355
 356   /* Force a keymap flush for the next call to where-is.
 357      Since this can be called from within where-is, we don't set where_is_cache
 358      directly but only where_is_cache_keymaps, since where_is_cache shouldn't
 359      be changed during where-is, while where_is_cache_keymaps is only used at
 360      the very beginning of where-is and can thus be changed here without any
 361      adverse effect.
 362      This is a very minor correctness (rather than safety) issue.  */
 363   where_is_cache_keymaps = Qt;
 364
 365   GCPRO2 (keymap, parent);
 366   keymap = get_keymap (keymap, 1, 1);
 367
 368   if (!NILP (parent))
 369     {
 370       parent = get_keymap (parent, 1, 1);
 371
 372       /* Check for cycles.  */
 373       if (keymap_memberp (keymap, parent))
 374         error ("Cyclic keymap inheritance");
 375     }
 376
 377   /* Skip past the initial element `keymap'.  */
 378   prev = keymap;
 379   while (1)
 380     {
 381       list = XCDR (prev);
 382       /* If there is a parent keymap here, replace it.
 383          If we came to the end, add the parent in PREV.  */
 384       if (!CONSP (list) || KEYMAPP (list))
 385         {
 386           /* If we already have the right parent, return now
 387              so that we avoid the loops below.  */
 388           if (EQ (XCDR (prev), parent))
 389             RETURN_UNGCPRO (parent);
 390
 391           XSETCDR (prev, parent);
 392           break;
 393         }
 394       prev = list;
 395     }
 396
 397   /* Scan through for submaps, and set their parents too.  */
 398
 399   for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
 400     {
 401       /* Stop the scan when we come to the parent.  */
 402       if (EQ (XCAR (list), Qkeymap))
 403         break;
 404
 405       /* If this element holds a prefix map, deal with it.  */
 406       if (CONSP (XCAR (list))
 407           && CONSP (XCDR (XCAR (list))))
 408         fix_submap_inheritance (keymap, XCAR (XCAR (list)),
 409                                 XCDR (XCAR (list)));
 410
 411       if (VECTORP (XCAR (list)))
 412         for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
 413           if (CONSP (XVECTOR (XCAR (list))->contents[i]))
 414             fix_submap_inheritance (keymap, make_number (i),
 415                                     XVECTOR (XCAR (list))->contents[i]);
 416
 417       if (CHAR_TABLE_P (XCAR (list)))
 418         {
 419           Lisp_Object indices[3];
 420
 421           map_char_table (fix_submap_inheritance, Qnil,
 422                           XCAR (list), XCAR (list),
 423                           keymap, 0, indices);
 424         }
 425     }
 426
 427   RETURN_UNGCPRO (parent);
 428 }
 429
 430 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
 431    if EVENT is also a prefix in MAP's parent,
 432    make sure that SUBMAP inherits that definition as its own parent.  */
 433
 434 static void
 435 fix_submap_inheritance (map, event, submap)
 436      Lisp_Object map, event, submap;
 437 {
 438   Lisp_Object map_parent, parent_entry;
 439
 440   /* SUBMAP is a cons that we found as a key binding.
 441      Discard the other things found in a menu key binding.  */
 442
 443   submap = get_keymap (get_keyelt (submap, 0), 0, 0);
 444
 445   /* If it isn't a keymap now, there's no work to do.  */
 446   if (!CONSP (submap))
 447     return;
 448
 449   map_parent = keymap_parent (map, 0);
 450   if (!NILP (map_parent))
 451     parent_entry =
 452       get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
 453   else
 454     parent_entry = Qnil;
 455
 456   /* If MAP's parent has something other than a keymap,
 457      our own submap shadows it completely.  */
 458   if (!CONSP (parent_entry))
 459     return;
 460
 461   if (! EQ (parent_entry, submap))
 462     {
 463       Lisp_Object submap_parent;
 464       submap_parent = submap;
 465       while (1)
 466         {
 467           Lisp_Object tem;
 468
 469           tem = keymap_parent (submap_parent, 0);
 470
 471           if (KEYMAPP (tem))
 472             {
 473               if (keymap_memberp (tem, parent_entry))
 474                 /* Fset_keymap_parent could create a cycle.  */
 475                 return;
 476               submap_parent = tem;
 477             }
 478           else
 479             break;
 480         }
 481       Fset_keymap_parent (submap_parent, parent_entry);
 482     }
 483 }
 484 \f
 485 /* Look up IDX in MAP.  IDX may be any sort of event.
 486    Note that this does only one level of lookup; IDX must be a single
 487    event, not a sequence.
 488
 489    If T_OK is non-zero, bindings for Qt are treated as default
 490    bindings; any key left unmentioned by other tables and bindings is
 491    given the binding of Qt.
 492
 493    If T_OK is zero, bindings for Qt are not treated specially.
 494
 495    If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */
 496
 497 Lisp_Object
 498 access_keymap (map, idx, t_ok, noinherit, autoload)
 499      Lisp_Object map;
 500      Lisp_Object idx;
 501      int t_ok;
 502      int noinherit;
 503      int autoload;
 504 {
 505   Lisp_Object val;
 506
 507   /* Qunbound in VAL means we have found no binding yet.  */
 508   val = Qunbound;
 509
 510   /* If idx is a list (some sort of mouse click, perhaps?),
 511      the index we want to use is the car of the list, which
 512      ought to be a symbol.  */
 513   idx = EVENT_HEAD (idx);
 514
 515   /* If idx is a symbol, it might have modifiers, which need to
 516      be put in the canonical order.  */
 517   if (SYMBOLP (idx))
 518     idx = reorder_modifiers (idx);
 519   else if (INTEGERP (idx))
 520     /* Clobber the high bits that can be present on a machine
 521        with more than 24 bits of integer.  */
 522     XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
 523
 524   /* Handle the special meta -> esc mapping. */
 525   if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
 526     {
 527       /* See if there is a meta-map.  If there's none, there is
 528          no binding for IDX, unless a default binding exists in MAP.  */
 529       struct gcpro gcpro1;
 530       Lisp_Object meta_map;
 531       GCPRO1 (map);
 532       /* A strange value in which Meta is set would cause
 533          infinite recursion.  Protect against that.  */
 534       if (XINT (meta_prefix_char) & CHAR_META)
 535         meta_prefix_char = make_number (27);
 536       meta_map = get_keymap (access_keymap (map, meta_prefix_char,
 537                                             t_ok, noinherit, autoload),
 538                              0, autoload);
 539       UNGCPRO;
 540       if (CONSP (meta_map))
 541         {
 542           map = meta_map;
 543           idx = make_number (XUINT (idx) & ~meta_modifier);
 544         }
 545       else if (t_ok)
 546         /* Set IDX to t, so that we only find a default binding.  */
 547         idx = Qt;
 548       else
 549         /* We know there is no binding.  */
 550         return Qnil;
 551     }
 552
 553   /* t_binding is where we put a default binding that applies,
 554      to use in case we do not find a binding specifically
 555      for this key sequence.  */
 556   {
 557     Lisp_Object tail;
 558     Lisp_Object t_binding = Qnil;
 559     struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 560
 561     GCPRO4 (map, tail, idx, t_binding);
 562
 563     /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
 564        If it is 1, only generic-char bindings are accepted.
 565        Otherwise, neither are.  */
 566     t_ok = t_ok ? 2 : 0;
 567
 568     for (tail = XCDR (map);
 569          (CONSP (tail)
 570           || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
 571          tail = XCDR (tail))
 572       {
 573         Lisp_Object binding;
 574
 575         binding = XCAR (tail);
 576         if (SYMBOLP (binding))
 577           {
 578             /* If NOINHERIT, stop finding prefix definitions
 579                after we pass a second occurrence of the `keymap' symbol.  */
 580             if (noinherit && EQ (binding, Qkeymap))
 581               RETURN_UNGCPRO (Qnil);
 582           }
 583         else if (CONSP (binding))
 584           {
 585             Lisp_Object key = XCAR (binding);
 586
 587             if (EQ (key, idx))
 588               val = XCDR (binding);
 589             else if (t_ok
 590                      && INTEGERP (idx)
 591                      && (XINT (idx) & CHAR_MODIFIER_MASK) == 0
 592                      && INTEGERP (key)
 593                      && (XINT (key) & CHAR_MODIFIER_MASK) == 0
 594                      && !SINGLE_BYTE_CHAR_P (XINT (idx))
 595                      && !SINGLE_BYTE_CHAR_P (XINT (key))
 596                      && CHAR_VALID_P (XINT (key), 1)
 597                      && !CHAR_VALID_P (XINT (key), 0)
 598                      && (CHAR_CHARSET (XINT (key))
 599                          == CHAR_CHARSET (XINT (idx))))
 600               {
 601                 /* KEY is the generic character of the charset of IDX.
 602                    Use KEY's binding if there isn't a binding for IDX
 603                    itself.  */
 604                 t_binding = XCDR (binding);
 605                 t_ok = 0;
 606               }
 607             else if (t_ok > 1 && EQ (key, Qt))
 608               {
 609                 t_binding = XCDR (binding);
 610                 t_ok = 1;
 611               }
 612           }
 613         else if (VECTORP (binding))
 614           {
 615             if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
 616               val = AREF (binding, XFASTINT (idx));
 617           }
 618         else if (CHAR_TABLE_P (binding))
 619           {
 620             /* Character codes with modifiers
 621                are not included in a char-table.
 622                All character codes without modifiers are included.  */
 623             if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
 624               {
 625                 val = Faref (binding, idx);
 626                 /* `nil' has a special meaning for char-tables, so
 627                    we use something else to record an explicitly
 628                    unbound entry.  */
 629                 if (NILP (val))
 630                   val = Qunbound;
 631               }
 632           }
 633
 634         /* If we found a binding, clean it up and return it.  */
 635         if (!EQ (val, Qunbound))
 636           {
 637             if (EQ (val, Qt))
 638               /* A Qt binding is just like an explicit nil binding
 639                  (i.e. it shadows any parent binding but not bindings in
 640                  keymaps of lower precedence).  */
 641               val = Qnil;
 642             val = get_keyelt (val, autoload);
 643             if (KEYMAPP (val))
 644               fix_submap_inheritance (map, idx, val);
 645             RETURN_UNGCPRO (val);
 646           }
 647         QUIT;
 648       }
 649     UNGCPRO;
 650     return get_keyelt (t_binding, autoload);
 651   }
 652 }
 653
 654 static void
 655 map_keymap_item (fun, args, key, val, data)
 656      map_keymap_function_t fun;
 657      Lisp_Object args, key, val;
 658      void *data;
 659 {
 660   /* We should maybe try to detect bindings shadowed by previous
 661      ones and things like that.  */
 662   if (EQ (val, Qt))
 663     val = Qnil;
 664   (*fun) (key, val, args, data);
 665 }
 666
 667 static void
 668 map_keymap_char_table_item (args, key, val)
 669      Lisp_Object args, key, val;
 670 {
 671   if (!NILP (val))
 672     {
 673       map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
 674       args = XCDR (args);
 675       map_keymap_item (fun, XCDR (args), key, val,
 676                        XSAVE_VALUE (XCAR (args))->pointer);
 677     }
 678 }
 679
 680 /* Call FUN for every binding in MAP.
 681    FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
 682    AUTOLOAD if non-zero means that we can autoload keymaps if necessary.  */
 683 void
 684 map_keymap (map, fun, args, data, autoload)
 685      map_keymap_function_t fun;
 686      Lisp_Object map, args;
 687      void *data;
 688      int autoload;
 689 {
 690   struct gcpro gcpro1, gcpro2, gcpro3;
 691   Lisp_Object tail;
 692
 693   GCPRO3 (map, args, tail);
 694   map = get_keymap (map, 1, autoload);
 695   for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
 696        CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
 697        tail = XCDR (tail))
 698     {
 699       Lisp_Object binding = XCAR (tail);
 700
 701       if (CONSP (binding))
 702         map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
 703       else if (VECTORP (binding))
 704         {
 705           /* Loop over the char values represented in the vector.  */
 706           int len = ASIZE (binding);
 707           int c;
 708           for (c = 0; c < len; c++)
 709             {
 710               Lisp_Object character;
 711               XSETFASTINT (character, c);
 712               map_keymap_item (fun, args, character, AREF (binding, c), data);
 713             }
 714         }
 715       else if (CHAR_TABLE_P (binding))
 716         {
 717           Lisp_Object indices[3];
 718           map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
 719                           Fcons (make_save_value (fun, 0),
 720                                  Fcons (make_save_value (data, 0),
 721                                         args)),
 722                           0, indices);
 723         }
 724     }
 725   UNGCPRO;
 726 }
 727
 728 static void
 729 map_keymap_call (key, val, fun, dummy)
 730      Lisp_Object key, val, fun;
 731      void *dummy;
 732 {
 733   call2 (fun, key, val);
 734 }
 735
 736 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
 737        doc: /* Call FUNCTION for every binding in KEYMAP.
 738 FUNCTION is called with two arguments: the event and its binding.
 739 If KEYMAP has a parent, the parent's bindings are included as well.
 740 This works recursively: if the parent has itself a parent, then the
 741 grandparent's bindings are also included and so on.
 742 usage: (map-keymap FUNCTION KEYMAP)  */)
 743      (function, keymap, sort_first)
 744      Lisp_Object function, keymap, sort_first;
 745 {
 746   if (INTEGERP (function))
 747     /* We have to stop integers early since map_keymap gives them special
 748        significance.  */
 749     Fsignal (Qinvalid_function, Fcons (function, Qnil));
 750   if (! NILP (sort_first))
 751     return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
 752
 753   map_keymap (keymap, map_keymap_call, function, NULL, 1);
 754   return Qnil;
 755 }
 756
 757 /* Given OBJECT which was found in a slot in a keymap,
 758    trace indirect definitions to get the actual definition of that slot.
 759    An indirect definition is a list of the form
 760    (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
 761    and INDEX is the object to look up in KEYMAP to yield the definition.
 762
 763    Also if OBJECT has a menu string as the first element,
 764    remove that.  Also remove a menu help string as second element.
 765
 766    If AUTOLOAD is nonzero, load autoloadable keymaps
 767    that are referred to with indirection.
 768
 769    This can GC because menu_item_eval_property calls Feval.  */
 770
 771 Lisp_Object
 772 get_keyelt (object, autoload)
 773      Lisp_Object object;
 774      int autoload;
 775 {
 776   while (1)
 777     {
 778       if (!(CONSP (object)))
 779         /* This is really the value.  */
 780         return object;
 781
 782       /* If the keymap contents looks like (keymap ...) or (lambda ...)
 783          then use itself. */
 784       else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
 785         return object;
 786
 787       /* If the keymap contents looks like (menu-item name . DEFN)
 788          or (menu-item name DEFN ...) then use DEFN.
 789          This is a new format menu item.  */
 790       else if (EQ (XCAR (object), Qmenu_item))
 791         {
 792           if (CONSP (XCDR (object)))
 793             {
 794               Lisp_Object tem;
 795
 796               object = XCDR (XCDR (object));
 797               tem = object;
 798               if (CONSP (object))
 799                 object = XCAR (object);
 800
 801               /* If there's a `:filter FILTER', apply FILTER to the
 802                  menu-item's definition to get the real definition to
 803                  use.  */
 804               for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
 805                 if (EQ (XCAR (tem), QCfilter) && autoload)
 806                   {
 807                     Lisp_Object filter;
 808                     filter = XCAR (XCDR (tem));
 809                     filter = list2 (filter, list2 (Qquote, object));
 810                     object = menu_item_eval_property (filter);
 811                     break;
 812                   }
 813             }
 814           else
 815             /* Invalid keymap.  */
 816             return object;
 817         }
 818
 819       /* If the keymap contents looks like (STRING . DEFN), use DEFN.
 820          Keymap alist elements like (CHAR MENUSTRING . DEFN)
 821          will be used by HierarKey menus.  */
 822       else if (STRINGP (XCAR (object)))
 823         {
 824           object = XCDR (object);
 825           /* Also remove a menu help string, if any,
 826              following the menu item name.  */
 827           if (CONSP (object) && STRINGP (XCAR (object)))
 828             object = XCDR (object);
 829           /* Also remove the sublist that caches key equivalences, if any.  */
 830           if (CONSP (object) && CONSP (XCAR (object)))
 831             {
 832               Lisp_Object carcar;
 833               carcar = XCAR (XCAR (object));
 834               if (NILP (carcar) || VECTORP (carcar))
 835                 object = XCDR (object);
 836             }
 837         }
 838
 839       /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
 840       else
 841         {
 842           struct gcpro gcpro1;
 843           Lisp_Object map;
 844           GCPRO1 (object);
 845           map = get_keymap (Fcar_safe (object), 0, autoload);
 846           UNGCPRO;
 847           return (!CONSP (map) ? object /* Invalid keymap */
 848                   : access_keymap (map, Fcdr (object), 0, 0, autoload));
 849         }
 850     }
 851 }
 852
 853 static Lisp_Object
 854 store_in_keymap (keymap, idx, def)
 855      Lisp_Object keymap;
 856      register Lisp_Object idx;
 857      register Lisp_Object def;
 858 {
 859   /* Flush any reverse-map cache.  */
 860   where_is_cache = Qnil;
 861   where_is_cache_keymaps = Qt;
 862
 863   /* If we are preparing to dump, and DEF is a menu element
 864      with a menu item indicator, copy it to ensure it is not pure.  */
 865   if (CONSP (def) && PURE_P (def)
 866       && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
 867     def = Fcons (XCAR (def), XCDR (def));
 868
 869   if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
 870     error ("attempt to define a key in a non-keymap");
 871
 872   /* If idx is a list (some sort of mouse click, perhaps?),
 873      the index we want to use is the car of the list, which
 874      ought to be a symbol.  */
 875   idx = EVENT_HEAD (idx);
 876
 877   /* If idx is a symbol, it might have modifiers, which need to
 878      be put in the canonical order.  */
 879   if (SYMBOLP (idx))
 880     idx = reorder_modifiers (idx);
 881   else if (INTEGERP (idx))
 882     /* Clobber the high bits that can be present on a machine
 883        with more than 24 bits of integer.  */
 884     XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
 885
 886   /* Scan the keymap for a binding of idx.  */
 887   {
 888     Lisp_Object tail;
 889
 890     /* The cons after which we should insert new bindings.  If the
 891        keymap has a table element, we record its position here, so new
 892        bindings will go after it; this way, the table will stay
 893        towards the front of the alist and character lookups in dense
 894        keymaps will remain fast.  Otherwise, this just points at the
 895        front of the keymap.  */
 896     Lisp_Object insertion_point;
 897
 898     insertion_point = keymap;
 899     for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
 900       {
 901         Lisp_Object elt;
 902
 903         elt = XCAR (tail);
 904         if (VECTORP (elt))
 905           {
 906             if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
 907               {
 908                 ASET (elt, XFASTINT (idx), def);
 909                 return def;
 910               }
 911             insertion_point = tail;
 912           }
 913         else if (CHAR_TABLE_P (elt))
 914           {
 915             /* Character codes with modifiers
 916                are not included in a char-table.
 917                All character codes without modifiers are included.  */
 918             if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
 919               {
 920                 Faset (elt, idx,
 921                        /* `nil' has a special meaning for char-tables, so
 922                           we use something else to record an explicitly
 923                           unbound entry.  */
 924                        NILP (def) ? Qt : def);
 925                 return def;
 926               }
 927             insertion_point = tail;
 928           }
 929         else if (CONSP (elt))
 930           {
 931             if (EQ (idx, XCAR (elt)))
 932               {
 933                 XSETCDR (elt, def);
 934                 return def;
 935               }
 936           }
 937         else if (EQ (elt, Qkeymap))
 938           /* If we find a 'keymap' symbol in the spine of KEYMAP,
 939              then we must have found the start of a second keymap
 940              being used as the tail of KEYMAP, and a binding for IDX
 941              should be inserted before it.  */
 942           goto keymap_end;
 943
 944         QUIT;
 945       }
 946
 947   keymap_end:
 948     /* We have scanned the entire keymap, and not found a binding for
 949        IDX.  Let's add one.  */
 950     XSETCDR (insertion_point,
 951              Fcons (Fcons (idx, def), XCDR (insertion_point)));
 952   }
 953
 954   return def;
 955 }
 956
 957 EXFUN (Fcopy_keymap, 1);
 958
 959 Lisp_Object
 960 copy_keymap_item (elt)
 961      Lisp_Object elt;
 962 {
 963   Lisp_Object res, tem;
 964
 965   if (!CONSP (elt))
 966     return elt;
 967
 968   res = tem = elt;
 969
 970   /* Is this a new format menu item.  */
 971   if (EQ (XCAR (tem), Qmenu_item))
 972     {
 973       /* Copy cell with menu-item marker.  */
 974       res = elt = Fcons (XCAR (tem), XCDR (tem));
 975       tem = XCDR (elt);
 976       if (CONSP (tem))
 977         {
 978           /* Copy cell with menu-item name.  */
 979           XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
 980           elt = XCDR (elt);
 981           tem = XCDR (elt);
 982         }
 983       if (CONSP (tem))
 984         {
 985           /* Copy cell with binding and if the binding is a keymap,
 986              copy that.  */
 987           XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
 988           elt = XCDR (elt);
 989           tem = XCAR (elt);
 990           if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
 991             XSETCAR (elt, Fcopy_keymap (tem));
 992           tem = XCDR (elt);
 993           if (CONSP (tem) && CONSP (XCAR (tem)))
 994             /* Delete cache for key equivalences.  */
 995             XSETCDR (elt, XCDR (tem));
 996         }
 997     }
 998   else
 999     {
1000       /* It may be an old fomat menu item.
1001          Skip the optional menu string.  */
1002       if (STRINGP (XCAR (tem)))
1003         {
1004           /* Copy the cell, since copy-alist didn't go this deep.  */
1005           res = elt = Fcons (XCAR (tem), XCDR (tem));
1006           tem = XCDR (elt);
1007           /* Also skip the optional menu help string.  */
1008           if (CONSP (tem) && STRINGP (XCAR (tem)))
1009             {
1010               XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1011               elt = XCDR (elt);
1012               tem = XCDR (elt);
1013             }
1014           /* There may also be a list that caches key equivalences.
1015              Just delete it for the new keymap.  */
1016           if (CONSP (tem)
1017               && CONSP (XCAR (tem))
1018               && (NILP (XCAR (XCAR (tem)))
1019                   || VECTORP (XCAR (XCAR (tem)))))
1020             {
1021               XSETCDR (elt, XCDR (tem));
1022               tem = XCDR (tem);
1023             }
1024           if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1025             XSETCDR (elt, Fcopy_keymap (tem));
1026         }
1027       else if (EQ (XCAR (tem), Qkeymap))
1028         res = Fcopy_keymap (elt);
1029     }
1030   return res;
1031 }
1032
1033 static void
1034 copy_keymap_1 (chartable, idx, elt)
1035      Lisp_Object chartable, idx, elt;
1036 {
1037   Faset (chartable, idx, copy_keymap_item (elt));
1038 }
1039
1040 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1041        doc: /* Return a copy of the keymap KEYMAP.
1042 The copy starts out with the same definitions of KEYMAP,
1043 but changing either the copy or KEYMAP does not affect the other.
1044 Any key definitions that are subkeymaps are recursively copied.
1045 However, a key definition which is a symbol whose definition is a keymap
1046 is not copied.  */)
1047      (keymap)
1048      Lisp_Object keymap;
1049 {
1050   register Lisp_Object copy, tail;
1051   keymap = get_keymap (keymap, 1, 0);
1052   copy = tail = Fcons (Qkeymap, Qnil);
1053   keymap = XCDR (keymap);               /* Skip the `keymap' symbol.  */
1054
1055   while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1056     {
1057       Lisp_Object elt = XCAR (keymap);
1058       if (CHAR_TABLE_P (elt))
1059         {
1060           Lisp_Object indices[3];
1061           elt = Fcopy_sequence (elt);
1062           map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
1063         }
1064       else if (VECTORP (elt))
1065         {
1066           int i;
1067           elt = Fcopy_sequence (elt);
1068           for (i = 0; i < ASIZE (elt); i++)
1069             ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1070         }
1071       else if (CONSP (elt))
1072         elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1073       XSETCDR (tail, Fcons (elt, Qnil));
1074       tail = XCDR (tail);
1075       keymap = XCDR (keymap);
1076     }
1077   XSETCDR (tail, keymap);
1078   return copy;
1079 }
1080 \f
1081 /* Simple Keymap mutators and accessors.                                */
1082
1083 /* GC is possible in this function if it autoloads a keymap.  */
1084
1085 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1086        doc: /* In KEYMAP, define key sequence KEY as DEF.
1087 KEYMAP is a keymap.
1088
1089 KEY is a string or a vector of symbols and characters meaning a
1090 sequence of keystrokes and events.  Non-ASCII characters with codes
1091 above 127 (such as ISO Latin-1) can be included if you use a vector.
1092 Using [t] for KEY creates a default definition, which applies to any
1093 event type that has no other definition in this keymap.
1094
1095 DEF is anything that can be a key's definition:
1096  nil (means key is undefined in this keymap),
1097  a command (a Lisp function suitable for interactive calling),
1098  a string (treated as a keyboard macro),
1099  a keymap (to define a prefix key),
1100  a symbol (when the key is looked up, the symbol will stand for its
1101     function definition, which should at that time be one of the above,
1102     or another symbol whose function definition is used, etc.),
1103  a cons (STRING . DEFN), meaning that DEFN is the definition
1104     (DEFN should be a valid definition in its own right),
1105  or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP.
1106
1107 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1108 binding is altered.  If there is no binding for KEY, the new pair
1109 binding KEY to DEF is added at the front of KEYMAP.  */)
1110      (keymap, key, def)
1111      Lisp_Object keymap;
1112      Lisp_Object key;
1113      Lisp_Object def;
1114 {
1115   register int idx;
1116   register Lisp_Object c;
1117   register Lisp_Object cmd;
1118   int metized = 0;
1119   int meta_bit;
1120   int length;
1121   struct gcpro gcpro1, gcpro2, gcpro3;
1122
1123   GCPRO3 (keymap, key, def);
1124   keymap = get_keymap (keymap, 1, 1);
1125
1126   if (!VECTORP (key) && !STRINGP (key))
1127     key = wrong_type_argument (Qarrayp, key);
1128
1129   length = XFASTINT (Flength (key));
1130   if (length == 0)
1131     RETURN_UNGCPRO (Qnil);
1132
1133   if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1134     Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1135
1136   meta_bit = VECTORP (key) ? meta_modifier : 0x80;
1137
1138   idx = 0;
1139   while (1)
1140     {
1141       c = Faref (key, make_number (idx));
1142
1143       if (CONSP (c) && lucid_event_type_list_p (c))
1144         c = Fevent_convert_list (c);
1145
1146       if (SYMBOLP (c))
1147         silly_event_symbol_error (c);
1148
1149       if (INTEGERP (c)
1150           && (XINT (c) & meta_bit)
1151           && !metized)
1152         {
1153           c = meta_prefix_char;
1154           metized = 1;
1155         }
1156       else
1157         {
1158           if (INTEGERP (c))
1159             XSETINT (c, XINT (c) & ~meta_bit);
1160
1161           metized = 0;
1162           idx++;
1163         }
1164
1165       if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
1166         error ("Key sequence contains invalid event");
1167
1168       if (idx == length)
1169         RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1170
1171       cmd = access_keymap (keymap, c, 0, 1, 1);
1172
1173       /* If this key is undefined, make it a prefix.  */
1174       if (NILP (cmd))
1175         cmd = define_as_prefix (keymap, c);
1176
1177       keymap = get_keymap (cmd, 0, 1);
1178       if (!CONSP (keymap))
1179         /* We must use Fkey_description rather than just passing key to
1180            error; key might be a vector, not a string.  */
1181         error ("Key sequence %s uses invalid prefix characters",
1182                SDATA (Fkey_description (key, Qnil)));
1183     }
1184 }
1185
1186 /* This function may GC (it calls Fkey_binding).  */
1187
1188 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 1, 0,
1189        doc: /* Return the remapping for command COMMAND in current keymaps.
1190 Returns nil if COMMAND is not remapped (or not a symbol).  */)
1191      (command)
1192      Lisp_Object command;
1193 {
1194   if (!SYMBOLP (command))
1195     return Qnil;
1196
1197   ASET (command_remapping_vector, 1, command);
1198   return Fkey_binding (command_remapping_vector, Qnil, Qt);
1199 }
1200
1201 /* Value is number if KEY is too long; nil if valid but has no definition. */
1202 /* GC is possible in this function if it autoloads a keymap.  */
1203
1204 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1205        doc: /* In keymap KEYMAP, look up key sequence KEY.  Return the definition.
1206 nil means undefined.  See doc of `define-key' for kinds of definitions.
1207
1208 A number as value means KEY is "too long";
1209 that is, characters or symbols in it except for the last one
1210 fail to be a valid sequence of prefix characters in KEYMAP.
1211 The number is how many characters at the front of KEY
1212 it takes to reach a non-prefix command.
1213
1214 Normally, `lookup-key' ignores bindings for t, which act as default
1215 bindings, used when nothing else in the keymap applies; this makes it
1216 usable as a general function for probing keymaps.  However, if the
1217 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1218 recognize the default bindings, just as `read-key-sequence' does.  */)
1219      (keymap, key, accept_default)
1220      Lisp_Object keymap;
1221      Lisp_Object key;
1222      Lisp_Object accept_default;
1223 {
1224   register int idx;
1225   register Lisp_Object cmd;
1226   register Lisp_Object c;
1227   int length;
1228   int t_ok = !NILP (accept_default);
1229   struct gcpro gcpro1, gcpro2;
1230
1231   GCPRO2 (keymap, key);
1232   keymap = get_keymap (keymap, 1, 1);
1233
1234   if (!VECTORP (key) && !STRINGP (key))
1235     key = wrong_type_argument (Qarrayp, key);
1236
1237   length = XFASTINT (Flength (key));
1238   if (length == 0)
1239     RETURN_UNGCPRO (keymap);
1240
1241   idx = 0;
1242   while (1)
1243     {
1244       c = Faref (key, make_number (idx++));
1245
1246       if (CONSP (c) && lucid_event_type_list_p (c))
1247         c = Fevent_convert_list (c);
1248
1249       /* Turn the 8th bit of string chars into a meta modifier.  */
1250       if (INTEGERP (c) && XINT (c) & 0x80 && STRINGP (key))
1251         XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1252
1253       /* Allow string since binding for `menu-bar-select-buffer'
1254          includes the buffer name in the key sequence.  */
1255       if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1256         error ("Key sequence contains invalid event");
1257
1258       cmd = access_keymap (keymap, c, t_ok, 0, 1);
1259       if (idx == length)
1260         RETURN_UNGCPRO (cmd);
1261
1262       keymap = get_keymap (cmd, 0, 1);
1263       if (!CONSP (keymap))
1264         RETURN_UNGCPRO (make_number (idx));
1265
1266       QUIT;
1267     }
1268 }
1269
1270 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1271    Assume that currently it does not define C at all.
1272    Return the keymap.  */
1273
1274 static Lisp_Object
1275 define_as_prefix (keymap, c)
1276      Lisp_Object keymap, c;
1277 {
1278   Lisp_Object cmd;
1279
1280   cmd = Fmake_sparse_keymap (Qnil);
1281   /* If this key is defined as a prefix in an inherited keymap,
1282      make it a prefix in this map, and make its definition
1283      inherit the other prefix definition.  */
1284   cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1285   store_in_keymap (keymap, c, cmd);
1286
1287   return cmd;
1288 }
1289
1290 /* Append a key to the end of a key sequence.  We always make a vector.  */
1291
1292 Lisp_Object
1293 append_key (key_sequence, key)
1294      Lisp_Object key_sequence, key;
1295 {
1296   Lisp_Object args[2];
1297
1298   args[0] = key_sequence;
1299
1300   args[1] = Fcons (key, Qnil);
1301   return Fvconcat (2, args);
1302 }
1303
1304 /* Given a event type C which is a symbol,
1305    signal an error if is a mistake such as RET or M-RET or C-DEL, etc.  */
1306
1307 static void
1308 silly_event_symbol_error (c)
1309      Lisp_Object c;
1310 {
1311   Lisp_Object parsed, base, name, assoc;
1312   int modifiers;
1313
1314   parsed = parse_modifiers (c);
1315   modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1316   base = XCAR (parsed);
1317   name = Fsymbol_name (base);
1318   /* This alist includes elements such as ("RET" . "\\r").  */
1319   assoc = Fassoc (name, exclude_keys);
1320
1321   if (! NILP (assoc))
1322     {
1323       char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1324       char *p = new_mods;
1325       Lisp_Object keystring;
1326       if (modifiers & alt_modifier)
1327         { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1328       if (modifiers & ctrl_modifier)
1329         { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1330       if (modifiers & hyper_modifier)
1331         { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1332       if (modifiers & meta_modifier)
1333         { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1334       if (modifiers & shift_modifier)
1335         { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1336       if (modifiers & super_modifier)
1337         { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1338       *p = 0;
1339
1340       c = reorder_modifiers (c);
1341       keystring = concat2 (build_string (new_mods), XCDR (assoc));
1342
1343       error ((modifiers & ~meta_modifier
1344               ? "To bind the key %s, use [?%s], not [%s]"
1345               : "To bind the key %s, use \"%s\", not [%s]"),
1346              SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1347              SDATA (SYMBOL_NAME (c)));
1348     }
1349 }
1350 \f
1351 /* Global, local, and minor mode keymap stuff.                          */
1352
1353 /* We can't put these variables inside current_minor_maps, since under
1354    some systems, static gets macro-defined to be the empty string.
1355    Ickypoo.  */
1356 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1357 static int cmm_size = 0;
1358
1359 /* Error handler used in current_minor_maps.  */
1360 static Lisp_Object
1361 current_minor_maps_error ()
1362 {
1363   return Qnil;
1364 }
1365
1366 /* Store a pointer to an array of the keymaps of the currently active
1367    minor modes in *buf, and return the number of maps it contains.
1368
1369    This function always returns a pointer to the same buffer, and may
1370    free or reallocate it, so if you want to keep it for a long time or
1371    hand it out to lisp code, copy it.  This procedure will be called
1372    for every key sequence read, so the nice lispy approach (return a
1373    new assoclist, list, what have you) for each invocation would
1374    result in a lot of consing over time.
1375
1376    If we used xrealloc/xmalloc and ran out of memory, they would throw
1377    back to the command loop, which would try to read a key sequence,
1378    which would call this function again, resulting in an infinite
1379    loop.  Instead, we'll use realloc/malloc and silently truncate the
1380    list, let the key sequence be read, and hope some other piece of
1381    code signals the error.  */
1382 int
1383 current_minor_maps (modeptr, mapptr)
1384      Lisp_Object **modeptr, **mapptr;
1385 {
1386   int i = 0;
1387   int list_number = 0;
1388   Lisp_Object alist, assoc, var, val;
1389   Lisp_Object emulation_alists;
1390   Lisp_Object lists[2];
1391
1392   emulation_alists = Vemulation_mode_map_alists;
1393   lists[0] = Vminor_mode_overriding_map_alist;
1394   lists[1] = Vminor_mode_map_alist;
1395
1396   for (list_number = 0; list_number < 2; list_number++)
1397     {
1398       if (CONSP (emulation_alists))
1399         {
1400           alist = XCAR (emulation_alists);
1401           emulation_alists = XCDR (emulation_alists);
1402           if (SYMBOLP (alist))
1403             alist = find_symbol_value (alist);
1404           list_number = -1;
1405         }
1406       else
1407         alist = lists[list_number];
1408
1409       for ( ; CONSP (alist); alist = XCDR (alist))
1410         if ((assoc = XCAR (alist), CONSP (assoc))
1411             && (var = XCAR (assoc), SYMBOLP (var))
1412             && (val = find_symbol_value (var), !EQ (val, Qunbound))
1413             && !NILP (val))
1414           {
1415             Lisp_Object temp;
1416
1417             /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1418                and also an entry in Vminor_mode_map_alist,
1419                ignore the latter.  */
1420             if (list_number == 1)
1421               {
1422                 val = assq_no_quit (var, lists[0]);
1423                 if (!NILP (val))
1424                   continue;
1425               }
1426
1427             if (i >= cmm_size)
1428               {
1429                 int newsize, allocsize;
1430                 Lisp_Object *newmodes, *newmaps;
1431
1432                 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1433                 allocsize = newsize * sizeof *newmodes;
1434
1435                 /* Use malloc here.  See the comment above this function.
1436                    Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1437                 BLOCK_INPUT;
1438                 newmodes = (Lisp_Object *) malloc (allocsize);
1439                 if (newmodes)
1440                   {
1441                     if (cmm_modes)
1442                       {
1443                         bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1444                         free (cmm_modes);
1445                       }
1446                     cmm_modes = newmodes;
1447                   }
1448
1449                 newmaps = (Lisp_Object *) malloc (allocsize);
1450                 if (newmaps)
1451                   {
1452                     if (cmm_maps)
1453                       {
1454                         bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1455                         free (cmm_maps);
1456                       }
1457                     cmm_maps = newmaps;
1458                   }
1459                 UNBLOCK_INPUT;
1460
1461                 if (newmodes == NULL || newmaps == NULL)
1462                   break;
1463                 cmm_size = newsize;
1464               }
1465
1466             /* Get the keymap definition--or nil if it is not defined.  */
1467             temp = internal_condition_case_1 (Findirect_function,
1468                                               XCDR (assoc),
1469                                               Qerror, current_minor_maps_error);
1470             if (!NILP (temp))
1471               {
1472                 cmm_modes[i] = var;
1473                 cmm_maps [i] = temp;
1474                 i++;
1475               }
1476           }
1477     }
1478
1479   if (modeptr) *modeptr = cmm_modes;
1480   if (mapptr)  *mapptr  = cmm_maps;
1481   return i;
1482 }
1483
1484 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1485        0, 1, 0,
1486        doc: /* Return a list of the currently active keymaps.
1487 OLP if non-nil indicates that we should obey `overriding-local-map' and
1488 `overriding-terminal-local-map'.  */)
1489      (olp)
1490      Lisp_Object olp;
1491 {
1492   Lisp_Object keymaps = Fcons (current_global_map, Qnil);
1493
1494   if (!NILP (olp))
1495     {
1496       if (!NILP (current_kboard->Voverriding_terminal_local_map))
1497         keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1498       /* The doc said that overriding-terminal-local-map should
1499          override overriding-local-map.  The code used them both,
1500          but it seems clearer to use just one.  rms, jan 2005.  */
1501       else if (!NILP (Voverriding_local_map))
1502         keymaps = Fcons (Voverriding_local_map, keymaps);
1503     }
1504   if (NILP (XCDR (keymaps)))
1505     {
1506       Lisp_Object local;
1507       Lisp_Object *maps;
1508       int nmaps, i;
1509
1510       /* This usually returns the buffer's local map,
1511          but that can be overridden by a `local-map' property.  */
1512       local = get_local_map (PT, current_buffer, Qlocal_map);
1513       if (!NILP (local))
1514         keymaps = Fcons (local, keymaps);
1515
1516       /* Now put all the minor mode keymaps on the list.  */
1517       nmaps = current_minor_maps (0, &maps);
1518
1519       for (i = --nmaps; i >= 0; i--)
1520         if (!NILP (maps[i]))
1521           keymaps = Fcons (maps[i], keymaps);
1522
1523       /* This returns nil unless there is a `keymap' property.  */
1524       local = get_local_map (PT, current_buffer, Qkeymap);
1525       if (!NILP (local))
1526         keymaps = Fcons (local, keymaps);
1527     }
1528
1529   return keymaps;
1530 }
1531
1532 /* GC is possible in this function if it autoloads a keymap.  */
1533
1534 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0,
1535        doc: /* Return the binding for command KEY in current keymaps.
1536 KEY is a string or vector, a sequence of keystrokes.
1537 The binding is probably a symbol with a function definition.
1538
1539 Normally, `key-binding' ignores bindings for t, which act as default
1540 bindings, used when nothing else in the keymap applies; this makes it
1541 usable as a general function for probing keymaps.  However, if the
1542 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1543 recognize the default bindings, just as `read-key-sequence' does.
1544
1545 Like the normal command loop, `key-binding' will remap the command
1546 resulting from looking up KEY by looking up the command in the
1547 current keymaps.  However, if the optional third argument NO-REMAP
1548 is non-nil, `key-binding' returns the unmapped command.  */)
1549      (key, accept_default, no_remap)
1550      Lisp_Object key, accept_default, no_remap;
1551 {
1552   Lisp_Object *maps, value;
1553   int nmaps, i;
1554   struct gcpro gcpro1;
1555
1556   GCPRO1 (key);
1557
1558   if (!NILP (current_kboard->Voverriding_terminal_local_map))
1559     {
1560       value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1561                            key, accept_default);
1562       if (! NILP (value) && !INTEGERP (value))
1563         goto done;
1564     }
1565   else if (!NILP (Voverriding_local_map))
1566     {
1567       value = Flookup_key (Voverriding_local_map, key, accept_default);
1568       if (! NILP (value) && !INTEGERP (value))
1569         goto done;
1570     }
1571   else
1572     {
1573       Lisp_Object local;
1574
1575       local = get_local_map (PT, current_buffer, Qkeymap);
1576       if (! NILP (local))
1577         {
1578           value = Flookup_key (local, key, accept_default);
1579           if (! NILP (value) && !INTEGERP (value))
1580             goto done;
1581         }
1582
1583       nmaps = current_minor_maps (0, &maps);
1584       /* Note that all these maps are GCPRO'd
1585          in the places where we found them.  */
1586
1587       for (i = 0; i < nmaps; i++)
1588         if (! NILP (maps[i]))
1589           {
1590             value = Flookup_key (maps[i], key, accept_default);
1591             if (! NILP (value) && !INTEGERP (value))
1592               goto done;
1593           }
1594
1595       local = get_local_map (PT, current_buffer, Qlocal_map);
1596       if (! NILP (local))
1597         {
1598           value = Flookup_key (local, key, accept_default);
1599           if (! NILP (value) && !INTEGERP (value))
1600             goto done;
1601         }
1602     }
1603
1604   value = Flookup_key (current_global_map, key, accept_default);
1605
1606  done:
1607   UNGCPRO;
1608   if (NILP (value) || INTEGERP (value))
1609     return Qnil;
1610
1611   /* If the result of the ordinary keymap lookup is an interactive
1612      command, look for a key binding (ie. remapping) for that command.  */
1613
1614   if (NILP (no_remap) && SYMBOLP (value))
1615     {
1616       Lisp_Object value1;
1617       if (value1 = Fcommand_remapping (value), !NILP (value1))
1618         value = value1;
1619     }
1620
1621   return value;
1622 }
1623
1624 /* GC is possible in this function if it autoloads a keymap.  */
1625
1626 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1627        doc: /* Return the binding for command KEYS in current local keymap only.
1628 KEYS is a string or vector, a sequence of keystrokes.
1629 The binding is probably a symbol with a function definition.
1630
1631 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1632 bindings; see the description of `lookup-key' for more details about this.  */)
1633      (keys, accept_default)
1634      Lisp_Object keys, accept_default;
1635 {
1636   register Lisp_Object map;
1637   map = current_buffer->keymap;
1638   if (NILP (map))
1639     return Qnil;
1640   return Flookup_key (map, keys, accept_default);
1641 }
1642
1643 /* GC is possible in this function if it autoloads a keymap.  */
1644
1645 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1646        doc: /* Return the binding for command KEYS in current global keymap only.
1647 KEYS is a string or vector, a sequence of keystrokes.
1648 The binding is probably a symbol with a function definition.
1649 This function's return values are the same as those of `lookup-key'
1650 \(which see).
1651
1652 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1653 bindings; see the description of `lookup-key' for more details about this.  */)
1654      (keys, accept_default)
1655      Lisp_Object keys, accept_default;
1656 {
1657   return Flookup_key (current_global_map, keys, accept_default);
1658 }
1659
1660 /* GC is possible in this function if it autoloads a keymap.  */
1661
1662 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1663        doc: /* Find the visible minor mode bindings of KEY.
1664 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
1665 the symbol which names the minor mode binding KEY, and BINDING is
1666 KEY's definition in that mode.  In particular, if KEY has no
1667 minor-mode bindings, return nil.  If the first binding is a
1668 non-prefix, all subsequent bindings will be omitted, since they would
1669 be ignored.  Similarly, the list doesn't include non-prefix bindings
1670 that come after prefix bindings.
1671
1672 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1673 bindings; see the description of `lookup-key' for more details about this.  */)
1674      (key, accept_default)
1675      Lisp_Object key, accept_default;
1676 {
1677   Lisp_Object *modes, *maps;
1678   int nmaps;
1679   Lisp_Object binding;
1680   int i, j;
1681   struct gcpro gcpro1, gcpro2;
1682
1683   nmaps = current_minor_maps (&modes, &maps);
1684   /* Note that all these maps are GCPRO'd
1685      in the places where we found them.  */
1686
1687   binding = Qnil;
1688   GCPRO2 (key, binding);
1689
1690   for (i = j = 0; i < nmaps; i++)
1691     if (!NILP (maps[i])
1692         && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1693         && !INTEGERP (binding))
1694       {
1695         if (KEYMAPP (binding))
1696           maps[j++] = Fcons (modes[i], binding);
1697         else if (j == 0)
1698           RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1699       }
1700
1701   UNGCPRO;
1702   return Flist (j, maps);
1703 }
1704
1705 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1706        doc: /* Define COMMAND as a prefix command.  COMMAND should be a symbol.
1707 A new sparse keymap is stored as COMMAND's function definition and its value.
1708 If a second optional argument MAPVAR is given, the map is stored as
1709 its value instead of as COMMAND's value; but COMMAND is still defined
1710 as a function.
1711 The third optional argument NAME, if given, supplies a menu name
1712 string for the map.  This is required to use the keymap as a menu.
1713 This function returns COMMAND.  */)
1714      (command, mapvar, name)
1715      Lisp_Object command, mapvar, name;
1716 {
1717   Lisp_Object map;
1718   map = Fmake_sparse_keymap (name);
1719   Ffset (command, map);
1720   if (!NILP (mapvar))
1721     Fset (mapvar, map);
1722   else
1723     Fset (command, map);
1724   return command;
1725 }
1726
1727 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1728        doc: /* Select KEYMAP as the global keymap.  */)
1729      (keymap)
1730      Lisp_Object keymap;
1731 {
1732   keymap = get_keymap (keymap, 1, 1);
1733   current_global_map = keymap;
1734
1735   return Qnil;
1736 }
1737
1738 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1739        doc: /* Select KEYMAP as the local keymap.
1740 If KEYMAP is nil, that means no local keymap.  */)
1741      (keymap)
1742      Lisp_Object keymap;
1743 {
1744   if (!NILP (keymap))
1745     keymap = get_keymap (keymap, 1, 1);
1746
1747   current_buffer->keymap = keymap;
1748
1749   return Qnil;
1750 }
1751
1752 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1753        doc: /* Return current buffer's local keymap, or nil if it has none.  */)
1754      ()
1755 {
1756   return current_buffer->keymap;
1757 }
1758
1759 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1760        doc: /* Return the current global keymap.  */)
1761      ()
1762 {
1763   return current_global_map;
1764 }
1765
1766 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1767        doc: /* Return a list of keymaps for the minor modes of the current buffer.  */)
1768      ()
1769 {
1770   Lisp_Object *maps;
1771   int nmaps = current_minor_maps (0, &maps);
1772
1773   return Flist (nmaps, maps);
1774 }
1775 \f
1776 /* Help functions for describing and documenting keymaps.               */
1777
1778
1779 static void
1780 accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
1781      Lisp_Object maps, tail, thisseq, key, cmd;
1782      int is_metized;            /* If 1, `key' is assumed to be INTEGERP.  */
1783 {
1784   Lisp_Object tem;
1785
1786   cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
1787   if (NILP (cmd))
1788     return;
1789
1790   /* Look for and break cycles.  */
1791   while (!NILP (tem = Frassq (cmd, maps)))
1792     {
1793       Lisp_Object prefix = XCAR (tem);
1794       int lim = XINT (Flength (XCAR (tem)));
1795       if (lim <= XINT (Flength (thisseq)))
1796         { /* This keymap was already seen with a smaller prefix.  */
1797           int i = 0;
1798           while (i < lim && EQ (Faref (prefix, make_number (i)),
1799                                 Faref (thisseq, make_number (i))))
1800             i++;
1801           if (i >= lim)
1802             /* `prefix' is a prefix of `thisseq' => there's a cycle.  */
1803             return;
1804         }
1805       /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1806          but maybe `cmd' occurs again further down in `maps', so keep
1807          looking.  */
1808       maps = XCDR (Fmemq (tem, maps));
1809     }
1810
1811   /* If the last key in thisseq is meta-prefix-char,
1812      turn it into a meta-ized keystroke.  We know
1813      that the event we're about to append is an
1814      ascii keystroke since we're processing a
1815      keymap table.  */
1816   if (is_metized)
1817     {
1818       int meta_bit = meta_modifier;
1819       Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
1820       tem = Fcopy_sequence (thisseq);
1821
1822       Faset (tem, last, make_number (XINT (key) | meta_bit));
1823
1824       /* This new sequence is the same length as
1825          thisseq, so stick it in the list right
1826          after this one.  */
1827       XSETCDR (tail,
1828                Fcons (Fcons (tem, cmd), XCDR (tail)));
1829     }
1830   else
1831     {
1832       tem = append_key (thisseq, key);
1833       nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1834     }
1835 }
1836
1837 static void
1838 accessible_keymaps_char_table (args, index, cmd)
1839      Lisp_Object args, index, cmd;
1840 {
1841   accessible_keymaps_1 (index, cmd,
1842                         XCAR (XCAR (args)),
1843                         XCAR (XCDR (args)),
1844                         XCDR (XCDR (args)),
1845                         XINT (XCDR (XCAR (args))));
1846 }
1847
1848 /* This function cannot GC.  */
1849
1850 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1851        1, 2, 0,
1852        doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
1853 Returns a list of elements of the form (KEYS . MAP), where the sequence
1854 KEYS starting from KEYMAP gets you to MAP.  These elements are ordered
1855 so that the KEYS increase in length.  The first element is ([] . KEYMAP).
1856 An optional argument PREFIX, if non-nil, should be a key sequence;
1857 then the value includes only maps for prefixes that start with PREFIX.  */)
1858      (keymap, prefix)
1859      Lisp_Object keymap, prefix;
1860 {
1861   Lisp_Object maps, tail;
1862   int prefixlen = 0;
1863
1864   /* no need for gcpro because we don't autoload any keymaps.  */
1865
1866   if (!NILP (prefix))
1867     prefixlen = XINT (Flength (prefix));
1868
1869   if (!NILP (prefix))
1870     {
1871       /* If a prefix was specified, start with the keymap (if any) for
1872          that prefix, so we don't waste time considering other prefixes.  */
1873       Lisp_Object tem;
1874       tem = Flookup_key (keymap, prefix, Qt);
1875       /* Flookup_key may give us nil, or a number,
1876          if the prefix is not defined in this particular map.
1877          It might even give us a list that isn't a keymap.  */
1878       tem = get_keymap (tem, 0, 0);
1879       if (CONSP (tem))
1880         {
1881           /* Convert PREFIX to a vector now, so that later on
1882              we don't have to deal with the possibility of a string.  */
1883           if (STRINGP (prefix))
1884             {
1885               int i, i_byte, c;
1886               Lisp_Object copy;
1887
1888               copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
1889               for (i = 0, i_byte = 0; i < SCHARS (prefix);)
1890                 {
1891                   int i_before = i;
1892
1893                   FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
1894                   if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1895                     c ^= 0200 | meta_modifier;
1896                   ASET (copy, i_before, make_number (c));
1897                 }
1898               prefix = copy;
1899             }
1900           maps = Fcons (Fcons (prefix, tem), Qnil);
1901         }
1902       else
1903         return Qnil;
1904     }
1905   else
1906     maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1907                          get_keymap (keymap, 1, 0)),
1908                   Qnil);
1909
1910   /* For each map in the list maps,
1911      look at any other maps it points to,
1912      and stick them at the end if they are not already in the list.
1913
1914      This is a breadth-first traversal, where tail is the queue of
1915      nodes, and maps accumulates a list of all nodes visited.  */
1916
1917   for (tail = maps; CONSP (tail); tail = XCDR (tail))
1918     {
1919       register Lisp_Object thisseq, thismap;
1920       Lisp_Object last;
1921       /* Does the current sequence end in the meta-prefix-char?  */
1922       int is_metized;
1923
1924       thisseq = Fcar (Fcar (tail));
1925       thismap = Fcdr (Fcar (tail));
1926       last = make_number (XINT (Flength (thisseq)) - 1);
1927       is_metized = (XINT (last) >= 0
1928                     /* Don't metize the last char of PREFIX.  */
1929                     && XINT (last) >= prefixlen
1930                     && EQ (Faref (thisseq, last), meta_prefix_char));
1931
1932       for (; CONSP (thismap); thismap = XCDR (thismap))
1933         {
1934           Lisp_Object elt;
1935
1936           elt = XCAR (thismap);
1937
1938           QUIT;
1939
1940           if (CHAR_TABLE_P (elt))
1941             {
1942               Lisp_Object indices[3];
1943
1944               map_char_table (accessible_keymaps_char_table, Qnil, elt,
1945                               elt, Fcons (Fcons (maps, make_number (is_metized)),
1946                                           Fcons (tail, thisseq)),
1947                               0, indices);
1948             }
1949           else if (VECTORP (elt))
1950             {
1951               register int i;
1952
1953               /* Vector keymap.  Scan all the elements.  */
1954               for (i = 0; i < ASIZE (elt); i++)
1955                 accessible_keymaps_1 (make_number (i), AREF (elt, i),
1956                                       maps, tail, thisseq, is_metized);
1957
1958             }
1959           else if (CONSP (elt))
1960             accessible_keymaps_1 (XCAR (elt), XCDR (elt),
1961                                   maps, tail, thisseq,
1962                                   is_metized && INTEGERP (XCAR (elt)));
1963
1964         }
1965     }
1966
1967   return maps;
1968 }
1969 \f
1970 Lisp_Object Qsingle_key_description, Qkey_description;
1971
1972 /* This function cannot GC.  */
1973
1974 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
1975        doc: /* Return a pretty description of key-sequence KEYS.
1976 Optional arg PREFIX is the sequence of keys leading up to KEYS.
1977 Control characters turn into "C-foo" sequences, meta into "M-foo",
1978 spaces are put between sequence elements, etc.  */)
1979   (keys, prefix)
1980      Lisp_Object keys, prefix;
1981 {
1982   int len = 0;
1983   int i, i_byte;
1984   Lisp_Object *args;
1985   int size = XINT (Flength (keys));
1986   Lisp_Object list;
1987   Lisp_Object sep = build_string (" ");
1988   Lisp_Object key;
1989   int add_meta = 0;
1990
1991   if (!NILP (prefix))
1992     size += XINT (Flength (prefix));
1993
1994   /* This has one extra element at the end that we don't pass to Fconcat.  */
1995   args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
1996
1997   /* In effect, this computes
1998      (mapconcat 'single-key-description keys " ")
1999      but we shouldn't use mapconcat because it can do GC.  */
2000
2001  next_list:
2002   if (!NILP (prefix))
2003     list = prefix, prefix = Qnil;
2004   else if (!NILP (keys))
2005     list = keys, keys = Qnil;
2006   else
2007     {
2008       if (add_meta)
2009         {
2010           args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2011           len += 2;
2012         }
2013       else if (len == 0)
2014         return empty_string;
2015       return Fconcat (len - 1, args);
2016     }
2017
2018   if (STRINGP (list))
2019     size = SCHARS (list);
2020   else if (VECTORP (list))
2021     size = XVECTOR (list)->size;
2022   else if (CONSP (list))
2023     size = XINT (Flength (list));
2024   else
2025     wrong_type_argument (Qarrayp, list);
2026
2027   i = i_byte = 0;
2028
2029   while (i < size)
2030     {
2031       if (STRINGP (list))
2032         {
2033           int c;
2034           FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2035           if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2036             c ^= 0200 | meta_modifier;
2037           XSETFASTINT (key, c);
2038         }
2039       else if (VECTORP (list))
2040         {
2041           key = AREF (list, i++);
2042         }
2043       else
2044         {
2045           key = XCAR (list);
2046           list = XCDR (list);
2047           i++;
2048         }
2049
2050       if (add_meta)
2051         {
2052           if (!INTEGERP (key)
2053               || EQ (key, meta_prefix_char)
2054               || (XINT (key) & meta_modifier))
2055             {
2056               args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2057               args[len++] = sep;
2058               if (EQ (key, meta_prefix_char))
2059                 continue;
2060             }
2061           else
2062             XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2063           add_meta = 0;
2064         }
2065       else if (EQ (key, meta_prefix_char))
2066         {
2067           add_meta = 1;
2068           continue;
2069         }
2070       args[len++] = Fsingle_key_description (key, Qnil);
2071       args[len++] = sep;
2072     }
2073   goto next_list;
2074 }
2075
2076
2077 char *
2078 push_key_description (c, p, force_multibyte)
2079      register unsigned int c;
2080      register char *p;
2081      int force_multibyte;
2082 {
2083   unsigned c2;
2084
2085   /* Clear all the meaningless bits above the meta bit.  */
2086   c &= meta_modifier | ~ - meta_modifier;
2087   c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2088              | meta_modifier | shift_modifier | super_modifier);
2089
2090   if (c & alt_modifier)
2091     {
2092       *p++ = 'A';
2093       *p++ = '-';
2094       c -= alt_modifier;
2095     }
2096   if ((c & ctrl_modifier) != 0
2097       || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2098     {
2099       *p++ = 'C';
2100       *p++ = '-';
2101       c &= ~ctrl_modifier;
2102     }
2103   if (c & hyper_modifier)
2104     {
2105       *p++ = 'H';
2106       *p++ = '-';
2107       c -= hyper_modifier;
2108     }
2109   if (c & meta_modifier)
2110     {
2111       *p++ = 'M';
2112       *p++ = '-';
2113       c -= meta_modifier;
2114     }
2115   if (c & shift_modifier)
2116     {
2117       *p++ = 'S';
2118       *p++ = '-';
2119       c -= shift_modifier;
2120     }
2121   if (c & super_modifier)
2122     {
2123       *p++ = 's';
2124       *p++ = '-';
2125       c -= super_modifier;
2126     }
2127   if (c < 040)
2128     {
2129       if (c == 033)
2130         {
2131           *p++ = 'E';
2132           *p++ = 'S';
2133           *p++ = 'C';
2134         }
2135       else if (c == '\t')
2136         {
2137           *p++ = 'T';
2138           *p++ = 'A';
2139           *p++ = 'B';
2140         }
2141       else if (c == Ctl ('M'))
2142         {
2143           *p++ = 'R';
2144           *p++ = 'E';
2145           *p++ = 'T';
2146         }
2147       else
2148         {
2149           /* `C-' already added above.  */
2150           if (c > 0 && c <= Ctl ('Z'))
2151             *p++ = c + 0140;
2152           else
2153             *p++ = c + 0100;
2154         }
2155     }
2156   else if (c == 0177)
2157     {
2158       *p++ = 'D';
2159       *p++ = 'E';
2160       *p++ = 'L';
2161     }
2162   else if (c == ' ')
2163    {
2164       *p++ = 'S';
2165       *p++ = 'P';
2166       *p++ = 'C';
2167     }
2168   else if (c < 128
2169            || (NILP (current_buffer->enable_multibyte_characters)
2170                && SINGLE_BYTE_CHAR_P (c)
2171                && !force_multibyte))
2172     {
2173       *p++ = c;
2174     }
2175   else
2176     {
2177       int valid_p = SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, 0);
2178
2179       if (force_multibyte && valid_p)
2180         {
2181           if (SINGLE_BYTE_CHAR_P (c))
2182             c = unibyte_char_to_multibyte (c);
2183           p += CHAR_STRING (c, p);
2184         }
2185       else if (NILP (current_buffer->enable_multibyte_characters)
2186                || valid_p)
2187         {
2188           int bit_offset;
2189           *p++ = '\\';
2190           /* The biggest character code uses 19 bits.  */
2191           for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
2192             {
2193               if (c >= (1 << bit_offset))
2194                 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
2195             }
2196         }
2197       else
2198         p += CHAR_STRING (c, p);
2199     }
2200
2201   return p;
2202 }
2203
2204 /* This function cannot GC.  */
2205
2206 DEFUN ("single-key-description", Fsingle_key_description,
2207        Ssingle_key_description, 1, 2, 0,
2208        doc: /* Return a pretty description of command character KEY.
2209 Control characters turn into C-whatever, etc.
2210 Optional argument NO-ANGLES non-nil means don't put angle brackets
2211 around function keys and event symbols.  */)
2212      (key, no_angles)
2213      Lisp_Object key, no_angles;
2214 {
2215   if (CONSP (key) && lucid_event_type_list_p (key))
2216     key = Fevent_convert_list (key);
2217
2218   key = EVENT_HEAD (key);
2219
2220   if (INTEGERP (key))           /* Normal character */
2221     {
2222       unsigned int charset, c1, c2;
2223       int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
2224
2225       if (SINGLE_BYTE_CHAR_P (without_bits))
2226         charset = 0;
2227       else
2228         SPLIT_CHAR (without_bits, charset, c1, c2);
2229
2230       if (charset
2231           && CHARSET_DEFINED_P (charset)
2232           && ((c1 >= 0 && c1 < 32)
2233               || (c2 >= 0 && c2 < 32)))
2234         {
2235           /* Handle a generic character.  */
2236           Lisp_Object name;
2237           name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
2238           CHECK_STRING (name);
2239           return concat2 (build_string ("Character set "), name);
2240         }
2241       else
2242         {
2243           char tem[KEY_DESCRIPTION_SIZE], *end;
2244           int nbytes, nchars;
2245           Lisp_Object string;
2246
2247           end = push_key_description (XUINT (key), tem, 1);
2248           nbytes = end - tem;
2249           nchars = multibyte_chars_in_text (tem, nbytes);
2250           if (nchars == nbytes)
2251             {
2252               *end = '\0';
2253               string = build_string (tem);
2254             }
2255           else
2256             string = make_multibyte_string (tem, nchars, nbytes);
2257           return string;
2258         }
2259     }
2260   else if (SYMBOLP (key))       /* Function key or event-symbol */
2261     {
2262       if (NILP (no_angles))
2263         {
2264           char *buffer
2265             = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2266           sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2267           return build_string (buffer);
2268         }
2269       else
2270         return Fsymbol_name (key);
2271     }
2272   else if (STRINGP (key))       /* Buffer names in the menubar.  */
2273     return Fcopy_sequence (key);
2274   else
2275     error ("KEY must be an integer, cons, symbol, or string");
2276   return Qnil;
2277 }
2278
2279 char *
2280 push_text_char_description (c, p)
2281      register unsigned int c;
2282      register char *p;
2283 {
2284   if (c >= 0200)
2285     {
2286       *p++ = 'M';
2287       *p++ = '-';
2288       c -= 0200;
2289     }
2290   if (c < 040)
2291     {
2292       *p++ = '^';
2293       *p++ = c + 64;            /* 'A' - 1 */
2294     }
2295   else if (c == 0177)
2296     {
2297       *p++ = '^';
2298       *p++ = '?';
2299     }
2300   else
2301     *p++ = c;
2302   return p;
2303 }
2304
2305 /* This function cannot GC.  */
2306
2307 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2308        doc: /* Return a pretty description of file-character CHARACTER.
2309 Control characters turn into "^char", etc.  This differs from
2310 `single-key-description' which turns them into "C-char".
2311 Also, this function recognizes the 2**7 bit as the Meta character,
2312 whereas `single-key-description' uses the 2**27 bit for Meta.
2313 See Info node `(elisp)Describing Characters' for examples.  */)
2314      (character)
2315      Lisp_Object character;
2316 {
2317   /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6).  */
2318   unsigned char str[6];
2319   int c;
2320
2321   CHECK_NUMBER (character);
2322
2323   c = XINT (character);
2324   if (!SINGLE_BYTE_CHAR_P (c))
2325     {
2326       int len = CHAR_STRING (c, str);
2327
2328       return make_multibyte_string (str, 1, len);
2329     }
2330
2331   *push_text_char_description (c & 0377, str) = 0;
2332
2333   return build_string (str);
2334 }
2335
2336 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2337    a meta bit.  */
2338 static int
2339 ascii_sequence_p (seq)
2340      Lisp_Object seq;
2341 {
2342   int i;
2343   int len = XINT (Flength (seq));
2344
2345   for (i = 0; i < len; i++)
2346     {
2347       Lisp_Object ii, elt;
2348
2349       XSETFASTINT (ii, i);
2350       elt = Faref (seq, ii);
2351
2352       if (!INTEGERP (elt)
2353           || (XUINT (elt) & ~CHAR_META) >= 0x80)
2354         return 0;
2355     }
2356
2357   return 1;
2358 }
2359
2360 \f
2361 /* where-is - finding a command in a set of keymaps.                    */
2362
2363 static Lisp_Object where_is_internal ();
2364 static Lisp_Object where_is_internal_1 ();
2365 static void where_is_internal_2 ();
2366
2367 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2368    Returns the first non-nil binding found in any of those maps.  */
2369
2370 static Lisp_Object
2371 shadow_lookup (shadow, key, flag)
2372      Lisp_Object shadow, key, flag;
2373 {
2374   Lisp_Object tail, value;
2375
2376   for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2377     {
2378       value = Flookup_key (XCAR (tail), key, flag);
2379       if (!NILP (value) && !NATNUMP (value))
2380         return value;
2381     }
2382   return Qnil;
2383 }
2384
2385 static Lisp_Object Vmouse_events;
2386
2387 /* This function can GC if Flookup_key autoloads any keymaps.  */
2388
2389 static Lisp_Object
2390 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2391      Lisp_Object definition, keymaps;
2392      Lisp_Object firstonly, noindirect, no_remap;
2393 {
2394   Lisp_Object maps = Qnil;
2395   Lisp_Object found, sequences;
2396   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2397   /* 1 means ignore all menu bindings entirely.  */
2398   int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2399
2400   /* If this command is remapped, then it has no key bindings
2401      of its own.  */
2402   if (NILP (no_remap) && SYMBOLP (definition))
2403     {
2404       Lisp_Object tem;
2405       if (tem = Fcommand_remapping (definition), !NILP (tem))
2406         return Qnil;
2407     }
2408
2409   found = keymaps;
2410   while (CONSP (found))
2411     {
2412       maps =
2413         nconc2 (maps,
2414                 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2415       found = XCDR (found);
2416     }
2417
2418   GCPRO5 (definition, keymaps, maps, found, sequences);
2419   found = Qnil;
2420   sequences = Qnil;
2421
2422   for (; !NILP (maps); maps = Fcdr (maps))
2423     {
2424       /* Key sequence to reach map, and the map that it reaches */
2425       register Lisp_Object this, map, tem;
2426
2427       /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2428          [M-CHAR] sequences, check if last character of the sequence
2429          is the meta-prefix char.  */
2430       Lisp_Object last;
2431       int last_is_meta;
2432
2433       this = Fcar (Fcar (maps));
2434       map  = Fcdr (Fcar (maps));
2435       last = make_number (XINT (Flength (this)) - 1);
2436       last_is_meta = (XINT (last) >= 0
2437                       && EQ (Faref (this, last), meta_prefix_char));
2438
2439       /* if (nomenus && !ascii_sequence_p (this)) */
2440       if (nomenus && XINT (last) >= 0
2441           && SYMBOLP (tem = Faref (this, make_number (0)))
2442           && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2443         /* If no menu entries should be returned, skip over the
2444            keymaps bound to `menu-bar' and `tool-bar' and other
2445            non-ascii prefixes like `C-down-mouse-2'.  */
2446         continue;
2447
2448       QUIT;
2449
2450       while (CONSP (map))
2451         {
2452           /* Because the code we want to run on each binding is rather
2453              large, we don't want to have two separate loop bodies for
2454              sparse keymap bindings and tables; we want to iterate one
2455              loop body over both keymap and vector bindings.
2456
2457              For this reason, if Fcar (map) is a vector, we don't
2458              advance map to the next element until i indicates that we
2459              have finished off the vector.  */
2460           Lisp_Object elt, key, binding;
2461           elt = XCAR (map);
2462           map = XCDR (map);
2463
2464           sequences = Qnil;
2465
2466           QUIT;
2467
2468           /* Set key and binding to the current key and binding, and
2469              advance map and i to the next binding.  */
2470           if (VECTORP (elt))
2471             {
2472               Lisp_Object sequence;
2473               int i;
2474               /* In a vector, look at each element.  */
2475               for (i = 0; i < XVECTOR (elt)->size; i++)
2476                 {
2477                   binding = AREF (elt, i);
2478                   XSETFASTINT (key, i);
2479                   sequence = where_is_internal_1 (binding, key, definition,
2480                                                   noindirect, this,
2481                                                   last, nomenus, last_is_meta);
2482                   if (!NILP (sequence))
2483                     sequences = Fcons (sequence, sequences);
2484                 }
2485             }
2486           else if (CHAR_TABLE_P (elt))
2487             {
2488               Lisp_Object indices[3];
2489               Lisp_Object args;
2490
2491               args = Fcons (Fcons (Fcons (definition, noindirect),
2492                                    Qnil), /* Result accumulator.  */
2493                             Fcons (Fcons (this, last),
2494                                    Fcons (make_number (nomenus),
2495                                           make_number (last_is_meta))));
2496               map_char_table (where_is_internal_2, Qnil, elt, elt, args,
2497                               0, indices);
2498               sequences = XCDR (XCAR (args));
2499             }
2500           else if (CONSP (elt))
2501             {
2502               Lisp_Object sequence;
2503
2504               key = XCAR (elt);
2505               binding = XCDR (elt);
2506
2507               sequence = where_is_internal_1 (binding, key, definition,
2508                                               noindirect, this,
2509                                               last, nomenus, last_is_meta);
2510               if (!NILP (sequence))
2511                 sequences = Fcons (sequence, sequences);
2512             }
2513
2514
2515           while (!NILP (sequences))
2516             {
2517               Lisp_Object sequence, remapped, function;
2518
2519               sequence = XCAR (sequences);
2520               sequences = XCDR (sequences);
2521
2522               /* If the current sequence is a command remapping with
2523                  format [remap COMMAND], find the key sequences
2524                  which run COMMAND, and use those sequences instead.  */
2525               remapped = Qnil;
2526               if (NILP (no_remap)
2527                   && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2528                   && EQ (AREF (sequence, 0), Qremap)
2529                   && (function = AREF (sequence, 1), SYMBOLP (function)))
2530                 {
2531                   Lisp_Object remapped1;
2532
2533                   remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2534                   if (CONSP (remapped1))
2535                     {
2536                       /* Verify that this key binding actually maps to the
2537                          remapped command (see below).  */
2538                       if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2539                         continue;
2540                       sequence = XCAR (remapped1);
2541                       remapped = XCDR (remapped1);
2542                       goto record_sequence;
2543                     }
2544                 }
2545
2546               /* Verify that this key binding is not shadowed by another
2547                  binding for the same key, before we say it exists.
2548
2549                  Mechanism: look for local definition of this key and if
2550                  it is defined and does not match what we found then
2551                  ignore this key.
2552
2553                  Either nil or number as value from Flookup_key
2554                  means undefined.  */
2555               if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2556                 continue;
2557
2558             record_sequence:
2559               /* Don't annoy user with strings from a menu such as
2560                  Select Paste.  Change them all to "(any string)",
2561                  so that there seems to be only one menu item
2562                  to report. */
2563               if (! NILP (sequence))
2564                 {
2565                   Lisp_Object tem;
2566                   tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2567                   if (STRINGP (tem))
2568                     Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2569                            build_string ("(any string)"));
2570                 }
2571
2572               /* It is a true unshadowed match.  Record it, unless it's already
2573                  been seen (as could happen when inheriting keymaps).  */
2574               if (NILP (Fmember (sequence, found)))
2575                 found = Fcons (sequence, found);
2576
2577               /* If firstonly is Qnon_ascii, then we can return the first
2578                  binding we find.  If firstonly is not Qnon_ascii but not
2579                  nil, then we should return the first ascii-only binding
2580                  we find.  */
2581               if (EQ (firstonly, Qnon_ascii))
2582                 RETURN_UNGCPRO (sequence);
2583               else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2584                 RETURN_UNGCPRO (sequence);
2585
2586               if (CONSP (remapped))
2587                 {
2588                   sequence = XCAR (remapped);
2589                   remapped = XCDR (remapped);
2590                   goto record_sequence;
2591                 }
2592             }
2593         }
2594     }
2595
2596   UNGCPRO;
2597
2598   found = Fnreverse (found);
2599
2600   /* firstonly may have been t, but we may have gone all the way through
2601      the keymaps without finding an all-ASCII key sequence.  So just
2602      return the best we could find.  */
2603   if (!NILP (firstonly))
2604     return Fcar (found);
2605
2606   return found;
2607 }
2608
2609 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2610        doc: /* Return list of keys that invoke DEFINITION.
2611 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2612 If KEYMAP is nil, search all the currently active keymaps.
2613 If KEYMAP is a list of keymaps, search only those keymaps.
2614
2615 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2616 rather than a list of all possible key sequences.
2617 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2618 no matter what it is.
2619 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2620 \(or their meta variants) and entirely reject menu bindings.
2621
2622 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2623 to other keymaps or slots.  This makes it possible to search for an
2624 indirect definition itself.
2625
2626 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2627 that invoke a command which is remapped to DEFINITION, but include the
2628 remapped command in the returned list.  */)
2629      (definition, keymap, firstonly, noindirect, no_remap)
2630      Lisp_Object definition, keymap;
2631      Lisp_Object firstonly, noindirect, no_remap;
2632 {
2633   Lisp_Object sequences, keymaps;
2634   /* 1 means ignore all menu bindings entirely.  */
2635   int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2636   Lisp_Object result;
2637
2638   /* Find the relevant keymaps.  */
2639   if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2640     keymaps = keymap;
2641   else if (!NILP (keymap))
2642     keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2643   else
2644     keymaps = Fcurrent_active_maps (Qnil);
2645
2646   /* Only use caching for the menubar (i.e. called with (def nil t nil).
2647      We don't really need to check `keymap'.  */
2648   if (nomenus && NILP (noindirect) && NILP (keymap))
2649     {
2650       Lisp_Object *defns;
2651       int i, j, n;
2652       struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2653
2654       /* Check heuristic-consistency of the cache.  */
2655       if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2656         where_is_cache = Qnil;
2657
2658       if (NILP (where_is_cache))
2659         {
2660           /* We need to create the cache.  */
2661           Lisp_Object args[2];
2662           where_is_cache = Fmake_hash_table (0, args);
2663           where_is_cache_keymaps = Qt;
2664
2665           /* Fill in the cache.  */
2666           GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2667           where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2668           UNGCPRO;
2669
2670           where_is_cache_keymaps = keymaps;
2671         }
2672
2673       /* We want to process definitions from the last to the first.
2674          Instead of consing, copy definitions to a vector and step
2675          over that vector.  */
2676       sequences = Fgethash (definition, where_is_cache, Qnil);
2677       n = XINT (Flength (sequences));
2678       defns = (Lisp_Object *) alloca (n * sizeof *defns);
2679       for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2680         defns[i++] = XCAR (sequences);
2681
2682       /* Verify that the key bindings are not shadowed.  Note that
2683          the following can GC.  */
2684       GCPRO2 (definition, keymaps);
2685       result = Qnil;
2686       j = -1;
2687       for (i = n - 1; i >= 0; --i)
2688         if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2689           {
2690             if (ascii_sequence_p (defns[i]))
2691               break;
2692             else if (j < 0)
2693               j = i;
2694           }
2695
2696       result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
2697       UNGCPRO;
2698     }
2699   else
2700     {
2701       /* Kill the cache so that where_is_internal_1 doesn't think
2702          we're filling it up.  */
2703       where_is_cache = Qnil;
2704       result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2705     }
2706
2707   return result;
2708 }
2709
2710 /* This is the function that Fwhere_is_internal calls using map_char_table.
2711    ARGS has the form
2712    (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2713     .
2714     ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2715    Since map_char_table doesn't really use the return value from this function,
2716    we the result append to RESULT, the slot in ARGS.
2717
2718    This function can GC because it calls where_is_internal_1 which can
2719    GC.  */
2720
2721 static void
2722 where_is_internal_2 (args, key, binding)
2723      Lisp_Object args, key, binding;
2724 {
2725   Lisp_Object definition, noindirect, this, last;
2726   Lisp_Object result, sequence;
2727   int nomenus, last_is_meta;
2728   struct gcpro gcpro1, gcpro2, gcpro3;
2729
2730   GCPRO3 (args, key, binding);
2731   result = XCDR (XCAR (args));
2732   definition = XCAR (XCAR (XCAR (args)));
2733   noindirect = XCDR (XCAR (XCAR (args)));
2734   this = XCAR (XCAR (XCDR (args)));
2735   last = XCDR (XCAR (XCDR (args)));
2736   nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2737   last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2738
2739   sequence = where_is_internal_1 (binding, key, definition, noindirect,
2740                                   this, last, nomenus, last_is_meta);
2741
2742   if (!NILP (sequence))
2743     XSETCDR (XCAR (args), Fcons (sequence, result));
2744
2745   UNGCPRO;
2746 }
2747
2748
2749 /* This function can GC because get_keyelt can.  */
2750
2751 static Lisp_Object
2752 where_is_internal_1 (binding, key, definition, noindirect, this, last,
2753                      nomenus, last_is_meta)
2754      Lisp_Object binding, key, definition, noindirect, this, last;
2755      int nomenus, last_is_meta;
2756 {
2757   Lisp_Object sequence;
2758
2759   /* Search through indirections unless that's not wanted.  */
2760   if (NILP (noindirect))
2761     binding = get_keyelt (binding, 0);
2762
2763   /* End this iteration if this element does not match
2764      the target.  */
2765
2766   if (!(!NILP (where_is_cache)  /* everything "matches" during cache-fill.  */
2767         || EQ (binding, definition)
2768         || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2769     /* Doesn't match.  */
2770     return Qnil;
2771
2772   /* We have found a match.  Construct the key sequence where we found it.  */
2773   if (INTEGERP (key) && last_is_meta)
2774     {
2775       sequence = Fcopy_sequence (this);
2776       Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2777     }
2778   else
2779     sequence = append_key (this, key);
2780
2781   if (!NILP (where_is_cache))
2782     {
2783       Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2784       Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2785       return Qnil;
2786     }
2787   else
2788     return sequence;
2789 }
2790 \f
2791 /* describe-bindings - summarizing all the bindings in a set of keymaps.  */
2792
2793 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2794        doc: /* Insert the list of all defined keys and their definitions.
2795 The list is inserted in the current buffer, while the bindings are
2796 looked up in BUFFER.
2797 The optional argument PREFIX, if non-nil, should be a key sequence;
2798 then we display only bindings that start with that prefix.
2799 The optional argument MENUS, if non-nil, says to mention menu bindings.
2800 \(Ordinarily these are omitted from the output.)  */)
2801      (buffer, prefix, menus)
2802      Lisp_Object buffer, prefix, menus;
2803 {
2804   Lisp_Object outbuf, shadow;
2805   int nomenu = NILP (menus);
2806   register Lisp_Object start1;
2807   struct gcpro gcpro1;
2808
2809   char *alternate_heading
2810     = "\
2811 Keyboard translations:\n\n\
2812 You type        Translation\n\
2813 --------        -----------\n";
2814
2815   shadow = Qnil;
2816   GCPRO1 (shadow);
2817
2818   outbuf = Fcurrent_buffer ();
2819
2820   /* Report on alternates for keys.  */
2821   if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
2822     {
2823       int c;
2824       const unsigned char *translate = SDATA (Vkeyboard_translate_table);
2825       int translate_len = SCHARS (Vkeyboard_translate_table);
2826
2827       for (c = 0; c < translate_len; c++)
2828         if (translate[c] != c)
2829           {
2830             char buf[KEY_DESCRIPTION_SIZE];
2831             char *bufend;
2832
2833             if (alternate_heading)
2834               {
2835                 insert_string (alternate_heading);
2836                 alternate_heading = 0;
2837               }
2838
2839             bufend = push_key_description (translate[c], buf, 1);
2840             insert (buf, bufend - buf);
2841             Findent_to (make_number (16), make_number (1));
2842             bufend = push_key_description (c, buf, 1);
2843             insert (buf, bufend - buf);
2844
2845             insert ("\n", 1);
2846           }
2847
2848       insert ("\n", 1);
2849     }
2850
2851   if (!NILP (Vkey_translation_map))
2852     describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2853                        "Key translations", nomenu, 1, 0, 0);
2854
2855
2856   /* Print the (major mode) local map.  */
2857   start1 = Qnil;
2858   if (!NILP (current_kboard->Voverriding_terminal_local_map))
2859     start1 = current_kboard->Voverriding_terminal_local_map;
2860   else if (!NILP (Voverriding_local_map))
2861     start1 = Voverriding_local_map;
2862
2863   if (!NILP (start1))
2864     {
2865       describe_map_tree (start1, 1, shadow, prefix,
2866                          "\f\nOverriding Bindings", nomenu, 0, 0, 0);
2867       shadow = Fcons (start1, shadow);
2868     }
2869   else
2870     {
2871       /* Print the minor mode and major mode keymaps.  */
2872       int i, nmaps;
2873       Lisp_Object *modes, *maps;
2874
2875       /* Temporarily switch to `buffer', so that we can get that buffer's
2876          minor modes correctly.  */
2877       Fset_buffer (buffer);
2878
2879       nmaps = current_minor_maps (&modes, &maps);
2880       Fset_buffer (outbuf);
2881
2882       start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
2883                               XBUFFER (buffer), Qkeymap);
2884       if (!NILP (start1))
2885         {
2886           describe_map_tree (start1, 1, shadow, prefix,
2887                              "\f\n`keymap' Property Bindings", nomenu,
2888                              0, 0, 0);
2889           shadow = Fcons (start1, shadow);
2890         }
2891
2892       /* Print the minor mode maps.  */
2893       for (i = 0; i < nmaps; i++)
2894         {
2895           /* The title for a minor mode keymap
2896              is constructed at run time.
2897              We let describe_map_tree do the actual insertion
2898              because it takes care of other features when doing so.  */
2899           char *title, *p;
2900
2901           if (!SYMBOLP (modes[i]))
2902             abort();
2903
2904           p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
2905           *p++ = '\f';
2906           *p++ = '\n';
2907           *p++ = '`';
2908           bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
2909                  SCHARS (SYMBOL_NAME (modes[i])));
2910           p += SCHARS (SYMBOL_NAME (modes[i]));
2911           *p++ = '\'';
2912           bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
2913           p += sizeof (" Minor Mode Bindings") - 1;
2914           *p = 0;
2915
2916           describe_map_tree (maps[i], 1, shadow, prefix,
2917                              title, nomenu, 0, 0, 0);
2918           shadow = Fcons (maps[i], shadow);
2919         }
2920
2921       start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
2922                               XBUFFER (buffer), Qlocal_map);
2923       if (!NILP (start1))
2924         {
2925           if (EQ (start1, XBUFFER (buffer)->keymap))
2926             describe_map_tree (start1, 1, shadow, prefix,
2927                                "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
2928           else
2929             describe_map_tree (start1, 1, shadow, prefix,
2930                                "\f\n`local-map' Property Bindings",
2931                                nomenu, 0, 0, 0);
2932
2933           shadow = Fcons (start1, shadow);
2934         }
2935     }
2936
2937   describe_map_tree (current_global_map, 1, shadow, prefix,
2938                      "\f\nGlobal Bindings", nomenu, 0, 1, 0);
2939
2940   /* Print the function-key-map translations under this prefix.  */
2941   if (!NILP (Vfunction_key_map))
2942     describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
2943                        "\f\nFunction key map translations", nomenu, 1, 0, 0);
2944
2945   UNGCPRO;
2946   return Qnil;
2947 }
2948
2949 /* Insert a description of the key bindings in STARTMAP,
2950     followed by those of all maps reachable through STARTMAP.
2951    If PARTIAL is nonzero, omit certain "uninteresting" commands
2952     (such as `undefined').
2953    If SHADOW is non-nil, it is a list of maps;
2954     don't mention keys which would be shadowed by any of them.
2955    PREFIX, if non-nil, says mention only keys that start with PREFIX.
2956    TITLE, if not 0, is a string to insert at the beginning.
2957    TITLE should not end with a colon or a newline; we supply that.
2958    If NOMENU is not 0, then omit menu-bar commands.
2959
2960    If TRANSL is nonzero, the definitions are actually key translations
2961    so print strings and vectors differently.
2962
2963    If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2964    to look through.
2965
2966    If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
2967    don't omit it; instead, mention it but say it is shadowed.  */
2968
2969 void
2970 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
2971                    always_title, mention_shadow)
2972      Lisp_Object startmap, shadow, prefix;
2973      int partial;
2974      char *title;
2975      int nomenu;
2976      int transl;
2977      int always_title;
2978      int mention_shadow;
2979 {
2980   Lisp_Object maps, orig_maps, seen, sub_shadows;
2981   struct gcpro gcpro1, gcpro2, gcpro3;
2982   int something = 0;
2983   char *key_heading
2984     = "\
2985 key             binding\n\
2986 ---             -------\n";
2987
2988   orig_maps = maps = Faccessible_keymaps (startmap, prefix);
2989   seen = Qnil;
2990   sub_shadows = Qnil;
2991   GCPRO3 (maps, seen, sub_shadows);
2992
2993   if (nomenu)
2994     {
2995       Lisp_Object list;
2996
2997       /* Delete from MAPS each element that is for the menu bar.  */
2998       for (list = maps; !NILP (list); list = XCDR (list))
2999         {
3000           Lisp_Object elt, prefix, tem;
3001
3002           elt = Fcar (list);
3003           prefix = Fcar (elt);
3004           if (XVECTOR (prefix)->size >= 1)
3005             {
3006               tem = Faref (prefix, make_number (0));
3007               if (EQ (tem, Qmenu_bar))
3008                 maps = Fdelq (elt, maps);
3009             }
3010         }
3011     }
3012
3013   if (!NILP (maps) || always_title)
3014     {
3015       if (title)
3016         {
3017           insert_string (title);
3018           if (!NILP (prefix))
3019             {
3020               insert_string (" Starting With ");
3021               insert1 (Fkey_description (prefix, Qnil));
3022             }
3023           insert_string (":\n");
3024         }
3025       insert_string (key_heading);
3026       something = 1;
3027     }
3028
3029   for (; !NILP (maps); maps = Fcdr (maps))
3030     {
3031       register Lisp_Object elt, prefix, tail;
3032
3033       elt = Fcar (maps);
3034       prefix = Fcar (elt);
3035
3036       sub_shadows = Qnil;
3037
3038       for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3039         {
3040           Lisp_Object shmap;
3041
3042           shmap = XCAR (tail);
3043
3044           /* If the sequence by which we reach this keymap is zero-length,
3045              then the shadow map for this keymap is just SHADOW.  */
3046           if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3047               || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3048             ;
3049           /* If the sequence by which we reach this keymap actually has
3050              some elements, then the sequence's definition in SHADOW is
3051              what we should use.  */
3052           else
3053             {
3054               shmap = Flookup_key (shmap, Fcar (elt), Qt);
3055               if (INTEGERP (shmap))
3056                 shmap = Qnil;
3057             }
3058
3059           /* If shmap is not nil and not a keymap,
3060              it completely shadows this map, so don't
3061              describe this map at all.  */
3062           if (!NILP (shmap) && !KEYMAPP (shmap))
3063             goto skip;
3064
3065           if (!NILP (shmap))
3066             sub_shadows = Fcons (shmap, sub_shadows);
3067         }
3068
3069       /* Maps we have already listed in this loop shadow this map.  */
3070       for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3071         {
3072           Lisp_Object tem;
3073           tem = Fequal (Fcar (XCAR (tail)), prefix);
3074           if (!NILP (tem))
3075             sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3076         }
3077
3078       describe_map (Fcdr (elt), prefix,
3079                     transl ? describe_translation : describe_command,
3080                     partial, sub_shadows, &seen, nomenu, mention_shadow);
3081
3082     skip: ;
3083     }
3084
3085   if (something)
3086     insert_string ("\n");
3087
3088   UNGCPRO;
3089 }
3090
3091 static int previous_description_column;
3092
3093 static void
3094 describe_command (definition, args)
3095      Lisp_Object definition, args;
3096 {
3097   register Lisp_Object tem1;
3098   int column = (int) current_column (); /* iftc */
3099   int description_column;
3100
3101   /* If column 16 is no good, go to col 32;
3102      but don't push beyond that--go to next line instead.  */
3103   if (column > 30)
3104     {
3105       insert_char ('\n');
3106       description_column = 32;
3107     }
3108   else if (column > 14 || (column > 10 && previous_description_column == 32))
3109     description_column = 32;
3110   else
3111     description_column = 16;
3112
3113   Findent_to (make_number (description_column), make_number (1));
3114   previous_description_column = description_column;
3115
3116   if (SYMBOLP (definition))
3117     {
3118       tem1 = SYMBOL_NAME (definition);
3119       insert1 (tem1);
3120       insert_string ("\n");
3121     }
3122   else if (STRINGP (definition) || VECTORP (definition))
3123     insert_string ("Keyboard Macro\n");
3124   else if (KEYMAPP (definition))
3125     insert_string ("Prefix Command\n");
3126   else
3127     insert_string ("??\n");
3128 }
3129
3130 static void
3131 describe_translation (definition, args)
3132      Lisp_Object definition, args;
3133 {
3134   register Lisp_Object tem1;
3135
3136   Findent_to (make_number (16), make_number (1));
3137
3138   if (SYMBOLP (definition))
3139     {
3140       tem1 = SYMBOL_NAME (definition);
3141       insert1 (tem1);
3142       insert_string ("\n");
3143     }
3144   else if (STRINGP (definition) || VECTORP (definition))
3145     {
3146       insert1 (Fkey_description (definition, Qnil));
3147       insert_string ("\n");
3148     }
3149   else if (KEYMAPP (definition))
3150     insert_string ("Prefix Command\n");
3151   else
3152     insert_string ("??\n");
3153 }
3154
3155 /* Describe the contents of map MAP, assuming that this map itself is
3156    reached by the sequence of prefix keys PREFIX (a string or vector).
3157    PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above.  */
3158
3159 static void
3160 describe_map (map, prefix, elt_describer, partial, shadow,
3161               seen, nomenu, mention_shadow)
3162      register Lisp_Object map;
3163      Lisp_Object prefix;
3164      void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3165      int partial;
3166      Lisp_Object shadow;
3167      Lisp_Object *seen;
3168      int nomenu;
3169      int mention_shadow;
3170 {
3171   Lisp_Object tail, definition, event;
3172   Lisp_Object tem;
3173   Lisp_Object suppress;
3174   Lisp_Object kludge;
3175   int first = 1;
3176   struct gcpro gcpro1, gcpro2, gcpro3;
3177
3178   suppress = Qnil;
3179
3180   if (partial)
3181     suppress = intern ("suppress-keymap");
3182
3183   /* This vector gets used to present single keys to Flookup_key.  Since
3184      that is done once per keymap element, we don't want to cons up a
3185      fresh vector every time.  */
3186   kludge = Fmake_vector (make_number (1), Qnil);
3187   definition = Qnil;
3188
3189   GCPRO3 (prefix, definition, kludge);
3190
3191   for (tail = map; CONSP (tail); tail = XCDR (tail))
3192     {
3193       QUIT;
3194
3195       if (VECTORP (XCAR (tail))
3196           || CHAR_TABLE_P (XCAR (tail)))
3197         describe_vector (XCAR (tail),
3198                          prefix, Qnil, elt_describer, partial, shadow, map,
3199                          (int *)0, 0, 1, mention_shadow);
3200       else if (CONSP (XCAR (tail)))
3201         {
3202           int this_shadowed = 0;
3203           event = XCAR (XCAR (tail));
3204
3205           /* Ignore bindings whose "prefix" are not really valid events.
3206              (We get these in the frames and buffers menu.)  */
3207           if (!(SYMBOLP (event) || INTEGERP (event)))
3208             continue;
3209
3210           if (nomenu && EQ (event, Qmenu_bar))
3211             continue;
3212
3213           definition = get_keyelt (XCDR (XCAR (tail)), 0);
3214
3215           /* Don't show undefined commands or suppressed commands.  */
3216           if (NILP (definition)) continue;
3217           if (SYMBOLP (definition) && partial)
3218             {
3219               tem = Fget (definition, suppress);
3220               if (!NILP (tem))
3221                 continue;
3222             }
3223
3224           /* Don't show a command that isn't really visible
3225              because a local definition of the same key shadows it.  */
3226
3227           ASET (kludge, 0, event);
3228           if (!NILP (shadow))
3229             {
3230               tem = shadow_lookup (shadow, kludge, Qt);
3231               if (!NILP (tem))
3232                 {
3233                   if (mention_shadow)
3234                     this_shadowed = 1;
3235                   else
3236                     continue;
3237                 }
3238             }
3239
3240           tem = Flookup_key (map, kludge, Qt);
3241           if (!EQ (tem, definition)) continue;
3242
3243           if (first)
3244             {
3245               previous_description_column = 0;
3246               insert ("\n", 1);
3247               first = 0;
3248             }
3249
3250           /* THIS gets the string to describe the character EVENT.  */
3251           insert1 (Fkey_description (kludge, prefix));
3252
3253           /* Print a description of the definition of this character.
3254              elt_describer will take care of spacing out far enough
3255              for alignment purposes.  */
3256           (*elt_describer) (definition, Qnil);
3257
3258           if (this_shadowed)
3259             {
3260               SET_PT (PT - 1);
3261               insert_string ("  (binding currently shadowed)");
3262               SET_PT (PT + 1);
3263             }
3264         }
3265       else if (EQ (XCAR (tail), Qkeymap))
3266         {
3267           /* The same keymap might be in the structure twice, if we're
3268              using an inherited keymap.  So skip anything we've already
3269              encountered.  */
3270           tem = Fassq (tail, *seen);
3271           if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3272             break;
3273           *seen = Fcons (Fcons (tail, prefix), *seen);
3274         }
3275     }
3276
3277   UNGCPRO;
3278 }
3279
3280 static void
3281 describe_vector_princ (elt, fun)
3282      Lisp_Object elt, fun;
3283 {
3284   Findent_to (make_number (16), make_number (1));
3285   call1 (fun, elt);
3286   Fterpri (Qnil);
3287 }
3288
3289 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3290        doc: /* Insert a description of contents of VECTOR.
3291 This is text showing the elements of vector matched against indices.
3292 DESCRIBER is the output function used; nil means use `princ'.  */)
3293      (vector, describer)
3294      Lisp_Object vector, describer;
3295 {
3296   int count = SPECPDL_INDEX ();
3297   if (NILP (describer))
3298     describer = intern ("princ");
3299   specbind (Qstandard_output, Fcurrent_buffer ());
3300   CHECK_VECTOR_OR_CHAR_TABLE (vector);
3301   describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3302                    Qnil, Qnil, (int *)0, 0, 0, 0);
3303
3304   return unbind_to (count, Qnil);
3305 }
3306
3307 /* Insert in the current buffer a description of the contents of VECTOR.
3308    We call ELT_DESCRIBER to insert the description of one value found
3309    in VECTOR.
3310
3311    ELT_PREFIX describes what "comes before" the keys or indices defined
3312    by this vector.  This is a human-readable string whose size
3313    is not necessarily related to the situation.
3314
3315    If the vector is in a keymap, ELT_PREFIX is a prefix key which
3316    leads to this keymap.
3317
3318    If the vector is a chartable, ELT_PREFIX is the vector
3319    of bytes that lead to the character set or portion of a character
3320    set described by this chartable.
3321
3322    If PARTIAL is nonzero, it means do not mention suppressed commands
3323    (that assumes the vector is in a keymap).
3324
3325    SHADOW is a list of keymaps that shadow this map.
3326    If it is non-nil, then we look up the key in those maps
3327    and we don't mention it now if it is defined by any of them.
3328
3329    ENTIRE_MAP is the keymap in which this vector appears.
3330    If the definition in effect in the whole map does not match
3331    the one in this vector, we ignore this one.
3332
3333    When describing a sub-char-table, INDICES is a list of
3334    indices at higher levels in this char-table,
3335    and CHAR_TABLE_DEPTH says how many levels down we have gone.
3336
3337    KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3338
3339    ARGS is simply passed as the second argument to ELT_DESCRIBER.  */
3340
3341 static void
3342 describe_vector (vector, prefix, args, elt_describer,
3343                  partial, shadow, entire_map,
3344                  indices, char_table_depth, keymap_p,
3345                  mention_shadow)
3346      register Lisp_Object vector;
3347      Lisp_Object prefix, args;
3348      void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3349      int partial;
3350      Lisp_Object shadow;
3351      Lisp_Object entire_map;
3352      int *indices;
3353      int char_table_depth;
3354      int keymap_p;
3355      int mention_shadow;
3356 {
3357   Lisp_Object definition;
3358   Lisp_Object tem2;
3359   Lisp_Object elt_prefix = Qnil;
3360   register int i;
3361   Lisp_Object suppress;
3362   Lisp_Object kludge;
3363   int first = 1;
3364   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3365   /* Range of elements to be handled.  */
3366   int from, to;
3367   /* A flag to tell if a leaf in this level of char-table is not a
3368      generic character (i.e. a complete multibyte character).  */
3369   int complete_char;
3370   int character;
3371   int starting_i;
3372
3373   suppress = Qnil;
3374
3375   if (indices == 0)
3376     indices = (int *) alloca (3 * sizeof (int));
3377
3378   definition = Qnil;
3379
3380   if (!keymap_p)
3381     {
3382       /* Call Fkey_description first, to avoid GC bug for the other string.  */
3383       if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3384         {
3385           Lisp_Object tem;
3386           tem = Fkey_description (prefix, Qnil);
3387           elt_prefix = concat2 (tem, build_string (" "));
3388         }
3389       prefix = Qnil;
3390     }
3391
3392   /* This vector gets used to present single keys to Flookup_key.  Since
3393      that is done once per vector element, we don't want to cons up a
3394      fresh vector every time.  */
3395   kludge = Fmake_vector (make_number (1), Qnil);
3396   GCPRO4 (elt_prefix, prefix, definition, kludge);
3397
3398   if (partial)
3399     suppress = intern ("suppress-keymap");
3400
3401   if (CHAR_TABLE_P (vector))
3402     {
3403       if (char_table_depth == 0)
3404         {
3405           /* VECTOR is a top level char-table.  */
3406           complete_char = 1;
3407           from = 0;
3408           to = CHAR_TABLE_ORDINARY_SLOTS;
3409         }
3410       else
3411         {
3412           /* VECTOR is a sub char-table.  */
3413           if (char_table_depth >= 3)
3414             /* A char-table is never that deep.  */
3415             error ("Too deep char table");
3416
3417           complete_char
3418             = (CHARSET_VALID_P (indices[0])
3419                && ((CHARSET_DIMENSION (indices[0]) == 1
3420                     && char_table_depth == 1)
3421                    || char_table_depth == 2));
3422
3423           /* Meaningful elements are from 32th to 127th.  */
3424           from = 32;
3425           to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3426         }
3427     }
3428   else
3429     {
3430       /* This does the right thing for ordinary vectors.  */
3431
3432       complete_char = 1;
3433       from = 0;
3434       to = XVECTOR (vector)->size;
3435     }
3436
3437   for (i = from; i < to; i++)
3438     {
3439       int this_shadowed = 0;
3440       QUIT;
3441
3442       if (CHAR_TABLE_P (vector))
3443         {
3444           if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3445             complete_char = 0;
3446
3447           if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3448               && !CHARSET_DEFINED_P (i - 128))
3449             continue;
3450
3451           definition
3452             = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3453         }
3454       else
3455         definition = get_keyelt (AREF (vector, i), 0);
3456
3457       if (NILP (definition)) continue;
3458
3459       /* Don't mention suppressed commands.  */
3460       if (SYMBOLP (definition) && partial)
3461         {
3462           Lisp_Object tem;
3463
3464           tem = Fget (definition, suppress);
3465
3466           if (!NILP (tem)) continue;
3467         }
3468
3469       /* Set CHARACTER to the character this entry describes, if any.
3470          Also update *INDICES.  */
3471       if (CHAR_TABLE_P (vector))
3472         {
3473           indices[char_table_depth] = i;
3474
3475           if (char_table_depth == 0)
3476             {
3477               character = i;
3478               indices[0] = i - 128;
3479             }
3480           else if (complete_char)
3481             {
3482               character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3483             }
3484           else
3485             character = 0;
3486         }
3487       else
3488         character = i;
3489
3490       ASET (kludge, 0, make_number (character));
3491
3492       /* If this binding is shadowed by some other map, ignore it.  */
3493       if (!NILP (shadow) && complete_char)
3494         {
3495           Lisp_Object tem;
3496
3497           tem = shadow_lookup (shadow, kludge, Qt);
3498
3499           if (!NILP (tem))
3500             {
3501               if (mention_shadow)
3502                 this_shadowed = 1;
3503               else
3504                 continue;
3505             }
3506         }
3507
3508       /* Ignore this definition if it is shadowed by an earlier
3509          one in the same keymap.  */
3510       if (!NILP (entire_map) && complete_char)
3511         {
3512           Lisp_Object tem;
3513
3514           tem = Flookup_key (entire_map, kludge, Qt);
3515
3516           if (!EQ (tem, definition))
3517             continue;
3518         }
3519
3520       if (first)
3521         {
3522           if (char_table_depth == 0)
3523             insert ("\n", 1);
3524           first = 0;
3525         }
3526
3527       /* For a sub char-table, show the depth by indentation.
3528          CHAR_TABLE_DEPTH can be greater than 0 only for a char-table.  */
3529       if (char_table_depth > 0)
3530         insert ("    ", char_table_depth * 2); /* depth is 1 or 2.  */
3531
3532       /* Output the prefix that applies to every entry in this map.  */
3533       if (!NILP (elt_prefix))
3534         insert1 (elt_prefix);
3535
3536       /* Insert or describe the character this slot is for,
3537          or a description of what it is for.  */
3538       if (SUB_CHAR_TABLE_P (vector))
3539         {
3540           if (complete_char)
3541             insert_char (character);
3542           else
3543             {
3544               /* We need an octal representation for this block of
3545                  characters.  */
3546               char work[16];
3547               sprintf (work, "(row %d)", i);
3548               insert (work, strlen (work));
3549             }
3550         }
3551       else if (CHAR_TABLE_P (vector))
3552         {
3553           if (complete_char)
3554             insert1 (Fkey_description (kludge, prefix));
3555           else
3556             {
3557               /* Print the information for this character set.  */
3558               insert_string ("<");
3559               tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3560               if (STRINGP (tem2))
3561                 insert_from_string (tem2, 0, 0, SCHARS (tem2),
3562                                     SBYTES (tem2), 0);
3563               else
3564                 insert ("?", 1);
3565               insert (">", 1);
3566             }
3567         }
3568       else
3569         {
3570           insert1 (Fkey_description (kludge, prefix));
3571         }
3572
3573       /* If we find a sub char-table within a char-table,
3574          scan it recursively; it defines the details for
3575          a character set or a portion of a character set.  */
3576       if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3577         {
3578           insert ("\n", 1);
3579           describe_vector (definition, prefix, args, elt_describer,
3580                            partial, shadow, entire_map,
3581                            indices, char_table_depth + 1, keymap_p,
3582                            mention_shadow);
3583           continue;
3584         }
3585
3586       starting_i = i;
3587
3588       /* Find all consecutive characters or rows that have the same
3589          definition.  But, for elements of a top level char table, if
3590          they are for charsets, we had better describe one by one even
3591          if they have the same definition.  */
3592       if (CHAR_TABLE_P (vector))
3593         {
3594           int limit = to;
3595
3596           if (char_table_depth == 0)
3597             limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3598
3599           while (i + 1 < limit
3600                  && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3601                      !NILP (tem2))
3602                  && !NILP (Fequal (tem2, definition)))
3603             i++;
3604         }
3605       else
3606         while (i + 1 < to
3607                && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3608                    !NILP (tem2))
3609                && !NILP (Fequal (tem2, definition)))
3610           i++;
3611
3612
3613       /* If we have a range of more than one character,
3614          print where the range reaches to.  */
3615
3616       if (i != starting_i)
3617         {
3618           insert (" .. ", 4);
3619
3620           ASET (kludge, 0, make_number (i));
3621
3622           if (!NILP (elt_prefix))
3623             insert1 (elt_prefix);
3624
3625           if (CHAR_TABLE_P (vector))
3626             {
3627               if (char_table_depth == 0)
3628                 {
3629                   insert1 (Fkey_description (kludge, prefix));
3630                 }
3631               else if (complete_char)
3632                 {
3633                   indices[char_table_depth] = i;
3634                   character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3635                   insert_char (character);
3636                 }
3637               else
3638                 {
3639                   /* We need an octal representation for this block of
3640                      characters.  */
3641                   char work[16];
3642                   sprintf (work, "(row %d)", i);
3643                   insert (work, strlen (work));
3644                 }
3645             }
3646           else
3647             {
3648               insert1 (Fkey_description (kludge, prefix));
3649             }
3650         }
3651
3652       /* Print a description of the definition of this character.
3653          elt_describer will take care of spacing out far enough
3654          for alignment purposes.  */
3655       (*elt_describer) (definition, args);
3656
3657       if (this_shadowed)
3658         {
3659           SET_PT (PT - 1);
3660           insert_string ("  (binding currently shadowed)");
3661           SET_PT (PT + 1);
3662         }
3663     }
3664
3665   /* For (sub) char-table, print `defalt' slot at last.  */
3666   if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3667     {
3668       insert ("    ", char_table_depth * 2);
3669       insert_string ("<<default>>");
3670       (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3671     }
3672
3673   UNGCPRO;
3674 }
3675 \f
3676 /* Apropos - finding all symbols whose names match a regexp.            */
3677 static Lisp_Object apropos_predicate;
3678 static Lisp_Object apropos_accumulate;
3679
3680 static void
3681 apropos_accum (symbol, string)
3682      Lisp_Object symbol, string;
3683 {
3684   register Lisp_Object tem;
3685
3686   tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3687   if (!NILP (tem) && !NILP (apropos_predicate))
3688     tem = call1 (apropos_predicate, symbol);
3689   if (!NILP (tem))
3690     apropos_accumulate = Fcons (symbol, apropos_accumulate);
3691 }
3692
3693 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3694        doc: /* Show all symbols whose names contain match for REGEXP.
3695 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3696 for each symbol and a symbol is mentioned only if that returns non-nil.
3697 Return list of symbols found.  */)
3698      (regexp, predicate)
3699      Lisp_Object regexp, predicate;
3700 {
3701   Lisp_Object tem;
3702   CHECK_STRING (regexp);
3703   apropos_predicate = predicate;
3704   apropos_accumulate = Qnil;
3705   map_obarray (Vobarray, apropos_accum, regexp);
3706   tem = Fsort (apropos_accumulate, Qstring_lessp);
3707   apropos_accumulate = Qnil;
3708   apropos_predicate = Qnil;
3709   return tem;
3710 }
3711 \f
3712 void
3713 syms_of_keymap ()
3714 {
3715   Qkeymap = intern ("keymap");
3716   staticpro (&Qkeymap);
3717   staticpro (&apropos_predicate);
3718   staticpro (&apropos_accumulate);
3719   apropos_predicate = Qnil;
3720   apropos_accumulate = Qnil;
3721
3722   /* Now we are ready to set up this property, so we can
3723      create char tables.  */
3724   Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3725
3726   /* Initialize the keymaps standardly used.
3727      Each one is the value of a Lisp variable, and is also
3728      pointed to by a C variable */
3729
3730   global_map = Fmake_keymap (Qnil);
3731   Fset (intern ("global-map"), global_map);
3732
3733   current_global_map = global_map;
3734   staticpro (&global_map);
3735   staticpro (&current_global_map);
3736
3737   meta_map = Fmake_keymap (Qnil);
3738   Fset (intern ("esc-map"), meta_map);
3739   Ffset (intern ("ESC-prefix"), meta_map);
3740
3741   control_x_map = Fmake_keymap (Qnil);
3742   Fset (intern ("ctl-x-map"), control_x_map);
3743   Ffset (intern ("Control-X-prefix"), control_x_map);
3744
3745   exclude_keys
3746     = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3747              Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3748                     Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3749                            Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3750                                   Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3751                                          Qnil)))));
3752   staticpro (&exclude_keys);
3753
3754   DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3755                doc: /* List of commands given new key bindings recently.
3756 This is used for internal purposes during Emacs startup;
3757 don't alter it yourself.  */);
3758   Vdefine_key_rebound_commands = Qt;
3759
3760   DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3761                doc: /* Default keymap to use when reading from the minibuffer.  */);
3762   Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3763
3764   DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3765                doc: /* Local keymap for the minibuffer when spaces are not allowed.  */);
3766   Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3767   Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3768
3769   DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3770                doc: /* Local keymap for minibuffer input with completion.  */);
3771   Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3772   Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
3773
3774   DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
3775                doc: /* Local keymap for minibuffer input with completion, for exact match.  */);
3776   Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3777   Fset_keymap_parent (Vminibuffer_local_must_match_map,
3778                       Vminibuffer_local_completion_map);
3779
3780   DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
3781                doc: /* Alist of keymaps to use for minor modes.
3782 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3783 key sequences and look up bindings iff VARIABLE's value is non-nil.
3784 If two active keymaps bind the same key, the keymap appearing earlier
3785 in the list takes precedence.  */);
3786   Vminor_mode_map_alist = Qnil;
3787
3788   DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
3789                doc: /* Alist of keymaps to use for minor modes, in current major mode.
3790 This variable is an alist just like `minor-mode-map-alist', and it is
3791 used the same way (and before `minor-mode-map-alist'); however,
3792 it is provided for major modes to bind locally.  */);
3793   Vminor_mode_overriding_map_alist = Qnil;
3794
3795   DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
3796                doc: /* List of keymap alists to use for emulations modes.
3797 It is intended for modes or packages using multiple minor-mode keymaps.
3798 Each element is a keymap alist just like `minor-mode-map-alist', or a
3799 symbol with a variable binding which is a keymap alist, and it is used
3800 the same way.  The "active" keymaps in each alist are used before
3801 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'.  */);
3802   Vemulation_mode_map_alists = Qnil;
3803
3804
3805   DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
3806                doc: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3807 This allows Emacs to recognize function keys sent from ASCII
3808 terminals at any point in a key sequence.
3809
3810 The `read-key-sequence' function replaces any subsequence bound by
3811 `function-key-map' with its binding.  More precisely, when the active
3812 keymaps have no binding for the current key sequence but
3813 `function-key-map' binds a suffix of the sequence to a vector or string,
3814 `read-key-sequence' replaces the matching suffix with its binding, and
3815 continues with the new sequence.
3816
3817 The events that come from bindings in `function-key-map' are not
3818 themselves looked up in `function-key-map'.
3819
3820 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3821 Typing `ESC O P' to `read-key-sequence' would return [f1].  Typing
3822 `C-x ESC O P' would return [?\\C-x f1].  If [f1] were a prefix
3823 key, typing `ESC O P x' would return [f1 x].  */);
3824   Vfunction_key_map = Fmake_sparse_keymap (Qnil);
3825
3826   DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
3827                doc: /* Keymap of key translations that can override keymaps.
3828 This keymap works like `function-key-map', but comes after that,
3829 and its non-prefix bindings override ordinary bindings.  */);
3830   Vkey_translation_map = Qnil;
3831
3832   staticpro (&Vmouse_events);
3833   Vmouse_events = Fcons (intern ("menu-bar"),
3834                   Fcons (intern ("tool-bar"),
3835                   Fcons (intern ("header-line"),
3836                   Fcons (intern ("mode-line"),
3837                   Fcons (intern ("mouse-1"),
3838                   Fcons (intern ("mouse-2"),
3839                   Fcons (intern ("mouse-3"),
3840                   Fcons (intern ("mouse-4"),
3841                   Fcons (intern ("mouse-5"),
3842                          Qnil)))))))));
3843
3844
3845   Qsingle_key_description = intern ("single-key-description");
3846   staticpro (&Qsingle_key_description);
3847
3848   Qkey_description = intern ("key-description");
3849   staticpro (&Qkey_description);
3850
3851   Qkeymapp = intern ("keymapp");
3852   staticpro (&Qkeymapp);
3853
3854   Qnon_ascii = intern ("non-ascii");
3855   staticpro (&Qnon_ascii);
3856
3857   Qmenu_item = intern ("menu-item");
3858   staticpro (&Qmenu_item);
3859
3860   Qremap = intern ("remap");
3861   staticpro (&Qremap);
3862
3863   command_remapping_vector = Fmake_vector (make_number (2), Qremap);
3864   staticpro (&command_remapping_vector);
3865
3866   where_is_cache_keymaps = Qt;
3867   where_is_cache = Qnil;
3868   staticpro (&where_is_cache);
3869   staticpro (&where_is_cache_keymaps);
3870
3871   defsubr (&Skeymapp);
3872   defsubr (&Skeymap_parent);
3873   defsubr (&Skeymap_prompt);
3874   defsubr (&Sset_keymap_parent);
3875   defsubr (&Smake_keymap);
3876   defsubr (&Smake_sparse_keymap);
3877   defsubr (&Smap_keymap);
3878   defsubr (&Scopy_keymap);
3879   defsubr (&Scommand_remapping);
3880   defsubr (&Skey_binding);
3881   defsubr (&Slocal_key_binding);
3882   defsubr (&Sglobal_key_binding);
3883   defsubr (&Sminor_mode_key_binding);
3884   defsubr (&Sdefine_key);
3885   defsubr (&Slookup_key);
3886   defsubr (&Sdefine_prefix_command);
3887   defsubr (&Suse_global_map);
3888   defsubr (&Suse_local_map);
3889   defsubr (&Scurrent_local_map);
3890   defsubr (&Scurrent_global_map);
3891   defsubr (&Scurrent_minor_mode_maps);
3892   defsubr (&Scurrent_active_maps);
3893   defsubr (&Saccessible_keymaps);
3894   defsubr (&Skey_description);
3895   defsubr (&Sdescribe_vector);
3896   defsubr (&Ssingle_key_description);
3897   defsubr (&Stext_char_description);
3898   defsubr (&Swhere_is_internal);
3899   defsubr (&Sdescribe_buffer_bindings);
3900   defsubr (&Sapropos_internal);
3901 }
3902
3903 void
3904 keys_of_keymap ()
3905 {
3906   initial_define_key (global_map, 033, "ESC-prefix");
3907   initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
3908 }
3909
3910 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
3911    (do not change this comment) */