keymap.c 92 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Manipulation of keymaps
Gerd Moellmann's avatar
Gerd Moellmann committed
2 3
   Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000
   Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6 7 8

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Jim Blandy's avatar
Jim Blandy committed
9
the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
10 11 12 13 14 15 16 17 18
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
19 20
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Jim Blandy's avatar
Jim Blandy committed
21 22


23
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
24 25 26 27
#include <stdio.h>
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
28
#include "charset.h"
Jim Blandy's avatar
Jim Blandy committed
29
#include "keyboard.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
30
#include "termhooks.h"
31
#include "blockinput.h"
32
#include "puresize.h"
Dave Love's avatar
Dave Love committed
33
#include "intervals.h"
Jim Blandy's avatar
Jim Blandy committed
34 35

#define min(a, b) ((a) < (b) ? (a) : (b))
36
#define KEYMAPP(m) (!NILP (Fkeymapp (m)))
Jim Blandy's avatar
Jim Blandy committed
37

38
/* The number of elements in keymap vectors.  */
Jim Blandy's avatar
Jim Blandy committed
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
#define DENSE_TABLE_SIZE (0200)

/* Actually allocate storage for these variables */

Lisp_Object current_global_map;	/* Current global keymap */

Lisp_Object global_map;		/* default global key bindings */

Lisp_Object meta_map;		/* The keymap used for globally bound
				   ESC-prefixed default commands */

Lisp_Object control_x_map;	/* The keymap used for globally bound
				   C-x-prefixed default commands */

/* was MinibufLocalMap */
Lisp_Object Vminibuffer_local_map;
				/* The keymap used by the minibuf for local
				   bindings when spaces are allowed in the
				   minibuf */

/* was MinibufLocalNSMap */
Lisp_Object Vminibuffer_local_ns_map;			
				/* The keymap used by the minibuf for local
				   bindings when spaces are not encouraged
				   in the minibuf */

/* keymap used for minibuffers when doing completion */
/* was MinibufLocalCompletionMap */
Lisp_Object Vminibuffer_local_completion_map;

/* keymap used for minibuffers when doing completion and require a match */
/* was MinibufLocalMustMatchMap */
Lisp_Object Vminibuffer_local_must_match_map;

Jim Blandy's avatar
Jim Blandy committed
73 74 75
/* Alist of minor mode variables and keymaps.  */
Lisp_Object Vminor_mode_map_alist;

76 77 78 79
/* Alist of major-mode-specific overrides for
   minor mode variables and keymaps.  */
Lisp_Object Vminor_mode_overriding_map_alist;

Jim Blandy's avatar
Jim Blandy committed
80 81 82 83 84
/* Keymap mapping ASCII function key sequences onto their preferred forms.
   Initialized by the terminal-specific lisp files.  See DEFVAR for more
   documentation.  */
Lisp_Object Vfunction_key_map;

85 86 87
/* Keymap mapping ASCII function key sequences onto their preferred forms.  */
Lisp_Object Vkey_translation_map;

88 89 90 91 92 93
/* A list of all commands given new bindings since a certain time
   when nil was stored here.
   This is used to speed up recomputation of menu key equivalents
   when Emacs starts up.   t means don't record anything here.  */
Lisp_Object Vdefine_key_rebound_commands;

94
Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
Jim Blandy's avatar
Jim Blandy committed
95

Jim Blandy's avatar
Jim Blandy committed
96 97 98
/* A char with the CHAR_META bit set in a vector or the 0200 bit set
   in a string key sequence is equivalent to prefixing with this
   character.  */
Jim Blandy's avatar
Jim Blandy committed
99 100
extern Lisp_Object meta_prefix_char;

101 102
extern Lisp_Object Voverriding_local_map;

103 104 105 106 107 108 109 110 111 112
static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));

static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
static Lisp_Object describe_buffer_bindings P_ ((Lisp_Object));
static void describe_command P_ ((Lisp_Object));
static void describe_translation P_ ((Lisp_Object));
static void describe_map P_ ((Lisp_Object, Lisp_Object,
			      void (*) P_ ((Lisp_Object)),
			      int, Lisp_Object, Lisp_Object*, int));
Jim Blandy's avatar
Jim Blandy committed
113

Jim Blandy's avatar
Jim Blandy committed
114 115
/* Keymap object support - constructors and predicates.			*/

116
DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
117 118
  "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
CHARTABLE is a char-table that holds the bindings for the ASCII\n\
Jim Blandy's avatar
Jim Blandy committed
119 120
characters.  ALIST is an assoc-list which holds bindings for function keys,\n\
mouse events, and any other things that appear in the input stream.\n\
121 122 123 124 125
All entries in it are initially nil, meaning \"command undefined\".\n\n\
The optional arg STRING supplies a menu name for the keymap\n\
in case you use it as a menu with `x-popup-menu'.")
  (string)
     Lisp_Object string;
Jim Blandy's avatar
Jim Blandy committed
126
{
127 128 129 130 131
  Lisp_Object tail;
  if (!NILP (string))
    tail = Fcons (string, Qnil);
  else
    tail = Qnil;
Jim Blandy's avatar
Jim Blandy committed
132
  return Fcons (Qkeymap,
133
		Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
Jim Blandy's avatar
Jim Blandy committed
134 135
}

136
DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
137
  "Construct and return a new sparse keymap.\n\
Jim Blandy's avatar
Jim Blandy committed
138 139 140
Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
which binds the function key or mouse event SYMBOL to DEFINITION.\n\
141 142 143 144 145
Initially the alist is nil.\n\n\
The optional arg STRING supplies a menu name for the keymap\n\
in case you use it as a menu with `x-popup-menu'.")
  (string)
     Lisp_Object string;
Jim Blandy's avatar
Jim Blandy committed
146
{
147 148
  if (!NILP (string))
    return Fcons (Qkeymap, Fcons (string, Qnil));
Jim Blandy's avatar
Jim Blandy committed
149 150 151 152 153 154 155 156
  return Fcons (Qkeymap, Qnil);
}

/* This function is used for installing the standard key bindings
   at initialization time.

   For example:

157
   initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");  */
Jim Blandy's avatar
Jim Blandy committed
158 159 160 161 162 163 164 165 166 167

void
initial_define_key (keymap, key, defname)
     Lisp_Object keymap;
     int key;
     char *defname;
{
  store_in_keymap (keymap, make_number (key), intern (defname));
}

168 169 170 171 172 173 174 175 176
void
initial_define_lispy_key (keymap, keyname, defname)
     Lisp_Object keymap;
     char *keyname;
     char *defname;
{
  store_in_keymap (keymap, intern (keyname), intern (defname));
}

Jim Blandy's avatar
Jim Blandy committed
177
DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
178
  "Return t if OBJECT is a keymap.\n\
Jim Blandy's avatar
Jim Blandy committed
179
\n\
180
A keymap is a list (keymap . ALIST),\n\
Karl Heuer's avatar
Karl Heuer committed
181
or a symbol whose function definition is itself a keymap.\n\
Jim Blandy's avatar
Jim Blandy committed
182
ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
183 184
a vector of densely packed bindings for small character codes\n\
is also allowed as an element.")
Jim Blandy's avatar
Jim Blandy committed
185 186 187
  (object)
     Lisp_Object object;
{
188
  /* FIXME: Maybe this should return t for autoloaded keymaps?   -sm  */
189
  return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
190 191 192
}

/* Check that OBJECT is a keymap (after dereferencing through any
193 194 195 196
   symbols).  If it is, return it.

   If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
   is an autoload form, do the autoload and try again.
197
   If AUTOLOAD is nonzero, callers must assume GC is possible.
198 199 200 201 202 203 204 205

   ERROR controls how we respond if OBJECT isn't a keymap.
   If ERROR is non-zero, signal an error; otherwise, just return Qnil.

   Note that most of the time, we don't want to pursue autoloads.
   Functions like Faccessible_keymaps which scan entire keymap trees
   shouldn't load every autoloaded keymap.  I'm not sure about this,
   but it seems to me that only read_key_sequence, Flookup_key, and
206 207 208 209
   Fdefine_key should cause keymaps to be autoloaded.

   This function can GC when AUTOLOAD is non-zero, because it calls
   do_autoload which can GC.  */
210

Jim Blandy's avatar
Jim Blandy committed
211
Lisp_Object
212
get_keymap_1 (object, error, autoload)
Jim Blandy's avatar
Jim Blandy committed
213
     Lisp_Object object;
214
     int error, autoload;
Jim Blandy's avatar
Jim Blandy committed
215
{
216
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
217

218
 autoload_retry:
219 220 221 222 223 224 225
  if (NILP (object))
    goto end;
  if (CONSP (object) && EQ (XCAR (object), Qkeymap))
    return object;
  else
    {
      tem = indirect_function (object);
226
      if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
227 228
	return tem;
    }
229

230 231
  /* Should we do an autoload?  Autoload forms for keymaps have
     Qkeymap as their fifth element.  */
232
  if (autoload
233
      && SYMBOLP (object)
234
      && CONSP (tem)
235
      && EQ (XCAR (tem), Qautoload))
236
    {
237
      Lisp_Object tail;
238

239 240 241 242
      tail = Fnth (make_number (4), tem);
      if (EQ (tail, Qkeymap))
	{
	  struct gcpro gcpro1, gcpro2;
243

244 245
	  GCPRO2 (tem, object);
	  do_autoload (tem, object);
246 247 248 249
	  UNGCPRO;

	  goto autoload_retry;
	}
250 251
    }

252
 end:
Jim Blandy's avatar
Jim Blandy committed
253 254
  if (error)
    wrong_type_argument (Qkeymapp, object);
255
  return Qnil;
Jim Blandy's avatar
Jim Blandy committed
256 257
}

258 259 260

/* Follow any symbol chaining, and return the keymap denoted by OBJECT.
   If OBJECT doesn't denote a keymap at all, signal an error.  */
Jim Blandy's avatar
Jim Blandy committed
261 262 263 264
Lisp_Object
get_keymap (object)
     Lisp_Object object;
{
265
  return get_keymap_1 (object, 1, 0);
Jim Blandy's avatar
Jim Blandy committed
266
}
267 268 269 270 271 272 273 274 275 276 277 278 279 280

/* Return the parent map of the keymap MAP, or nil if it has none.
   We assume that MAP is a valid keymap.  */

DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
  "Return the parent keymap of KEYMAP.")
  (keymap)
     Lisp_Object keymap;
{
  Lisp_Object list;

  keymap = get_keymap_1 (keymap, 1, 1);

  /* Skip past the initial element `keymap'.  */
281 282
  list = XCDR (keymap);
  for (; CONSP (list); list = XCDR (list))
283 284
    {
      /* See if there is another `keymap'.  */
285
      if (KEYMAPP (list))
286 287 288
	return list;
    }

289
  return get_keymap_1(list, 0, 1);
290 291
}

292

293 294 295 296 297
/* Check whether MAP is one of MAPS parents.  */
int
keymap_memberp (map, maps)
     Lisp_Object map, maps;
{
298
  if (NILP (map)) return 0;
299 300 301 302 303
  while (KEYMAPP (maps) && !EQ (map, maps))
    maps = Fkeymap_parent (maps);
  return (EQ (map, maps));
}

304 305 306 307 308 309 310 311 312
/* Set the parent keymap of MAP to PARENT.  */

DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
  "Modify KEYMAP to set its parent map to PARENT.\n\
PARENT should be nil or another keymap.")
  (keymap, parent)
     Lisp_Object keymap, parent;
{
  Lisp_Object list, prev;
313
  struct gcpro gcpro1;
314
  int i;
Jim Blandy's avatar
Jim Blandy committed
315

316
  keymap = get_keymap_1 (keymap, 1, 1);
317 318
  GCPRO1 (keymap);
  
319
  if (!NILP (parent))
320 321 322 323
    {
      parent = get_keymap_1 (parent, 1, 1);

      /* Check for cycles.  */
324
      if (keymap_memberp (keymap, parent))
325 326
	error ("Cyclic keymap inheritance");
    }
Jim Blandy's avatar
Jim Blandy committed
327

328 329 330 331
  /* Skip past the initial element `keymap'.  */
  prev = keymap;
  while (1)
    {
332
      list = XCDR (prev);
333 334
      /* If there is a parent keymap here, replace it.
	 If we came to the end, add the parent in PREV.  */
335
      if (! CONSP (list) || KEYMAPP (list))
336
	{
337 338
	  /* If we already have the right parent, return now
	     so that we avoid the loops below.  */
339
	  if (EQ (XCDR (prev), parent))
340
	    RETURN_UNGCPRO (parent);
341

342
	  XCDR (prev) = parent;
343 344 345 346 347 348 349
	  break;
	}
      prev = list;
    }

  /* Scan through for submaps, and set their parents too.  */

350
  for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
351 352
    {
      /* Stop the scan when we come to the parent.  */
353
      if (EQ (XCAR (list), Qkeymap))
354 355 356
	break;

      /* If this element holds a prefix map, deal with it.  */
357 358 359 360 361 362 363 364
      if (CONSP (XCAR (list))
	  && CONSP (XCDR (XCAR (list))))
	fix_submap_inheritance (keymap, XCAR (XCAR (list)),
				XCDR (XCAR (list)));

      if (VECTORP (XCAR (list)))
	for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
	  if (CONSP (XVECTOR (XCAR (list))->contents[i]))
365
	    fix_submap_inheritance (keymap, make_number (i),
366
				    XVECTOR (XCAR (list))->contents[i]);
367

368
      if (CHAR_TABLE_P (XCAR (list)))
369
	{
370
	  Lisp_Object indices[3];
371

372
	  map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
373 374
			  keymap, 0, indices);
	}
375 376
    }

377
  RETURN_UNGCPRO (parent);
378 379 380 381 382 383
}

/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
   if EVENT is also a prefix in MAP's parent,
   make sure that SUBMAP inherits that definition as its own parent.  */

384
static void
385 386 387 388 389 390 391 392
fix_submap_inheritance (map, event, submap)
     Lisp_Object map, event, submap;
{
  Lisp_Object map_parent, parent_entry;

  /* SUBMAP is a cons that we found as a key binding.
     Discard the other things found in a menu key binding.  */

393
  submap = get_keymap_1 (get_keyelt (submap, 0), 0, 0);
394 395

  /* If it isn't a keymap now, there's no work to do.  */
396
  if (NILP (submap))
397 398 399 400
    return;

  map_parent = Fkeymap_parent (map);
  if (! NILP (map_parent))
401 402
    parent_entry =
      get_keymap_1 (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
403 404 405
  else
    parent_entry = Qnil;

406
  /* If MAP's parent has something other than a keymap,
407
     our own submap shadows it completely.  */
408
  if (NILP (parent_entry))
409
    return;
410

411
  if (! EQ (parent_entry, submap))
412 413 414 415 416 417
    {
      Lisp_Object submap_parent;
      submap_parent = submap;
      while (1)
	{
	  Lisp_Object tem;
418

419
	  tem = Fkeymap_parent (submap_parent);
420 421 422 423 424 425 426 427

	  if (KEYMAPP (tem))
	    {
	      if (keymap_memberp (tem, parent_entry))
		/* Fset_keymap_parent could create a cycle.  */
		return;
	      submap_parent = tem;
	    }
428 429 430 431 432
	  else
	    break;
	}
      Fset_keymap_parent (submap_parent, parent_entry);
    }
433 434
}

Jim Blandy's avatar
Jim Blandy committed
435
/* Look up IDX in MAP.  IDX may be any sort of event.
436
   Note that this does only one level of lookup; IDX must be a single
437 438 439 440 441 442
   event, not a sequence. 

   If T_OK is non-zero, bindings for Qt are treated as default
   bindings; any key left unmentioned by other tables and bindings is
   given the binding of Qt.  

443 444 445
   If T_OK is zero, bindings for Qt are not treated specially.

   If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */
Jim Blandy's avatar
Jim Blandy committed
446 447

Lisp_Object
448
access_keymap (map, idx, t_ok, noinherit, autoload)
Jim Blandy's avatar
Jim Blandy committed
449 450
     Lisp_Object map;
     Lisp_Object idx;
451
     int t_ok;
452
     int noinherit;
453
     int autoload;
Jim Blandy's avatar
Jim Blandy committed
454
{
455 456 457
  int noprefix = 0;
  Lisp_Object val;

Jim Blandy's avatar
Jim Blandy committed
458 459 460
  /* If idx is a list (some sort of mouse click, perhaps?),
     the index we want to use is the car of the list, which
     ought to be a symbol.  */
461
  idx = EVENT_HEAD (idx);
Jim Blandy's avatar
Jim Blandy committed
462

463 464
  /* If idx is a symbol, it might have modifiers, which need to
     be put in the canonical order.  */
465
  if (SYMBOLP (idx))
466
    idx = reorder_modifiers (idx);
467 468 469
  else if (INTEGERP (idx))
    /* Clobber the high bits that can be present on a machine
       with more than 24 bits of integer.  */
470
    XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
Jim Blandy's avatar
Jim Blandy committed
471

472 473 474
  /* Handle the special meta -> esc mapping. */
  if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
    {
475 476
      /* See if there is a meta-map.  If there's none, there is
         no binding for IDX, unless a default binding exists in MAP.  */
477
      Lisp_Object meta_map =
Gerd Moellmann's avatar
Gerd Moellmann committed
478 479
	get_keymap_1 (access_keymap (map, meta_prefix_char,
				     t_ok, noinherit, autoload),
480 481
		      0, autoload);
      if (!NILP (meta_map))
482
	{
483
	  map = meta_map;
484 485 486 487 488 489 490 491
	  idx = make_number (XUINT (idx) & ~meta_modifier);
	}
      else if (t_ok)
	/* Set IDX to t, so that we only find a default binding.  */
	idx = Qt;
      else
	/* We know there is no binding.  */
	return Qnil;
492 493
    }

494 495
  {
    Lisp_Object tail;
496
    Lisp_Object t_binding;
Jim Blandy's avatar
Jim Blandy committed
497

498
    t_binding = Qnil;
499
    for (tail = XCDR (map);
500 501 502
	 (CONSP (tail)
	  || (tail = get_keymap_1 (tail, 0, autoload),
	      CONSP (tail)));
503
	 tail = XCDR (tail))
Jim Blandy's avatar
Jim Blandy committed
504
      {
505
	Lisp_Object binding;
506

507
	binding = XCAR (tail);
508
	if (SYMBOLP (binding))
509
	  {
510 511
	    /* If NOINHERIT, stop finding prefix definitions
	       after we pass a second occurrence of the `keymap' symbol.  */
512
	    if (noinherit && EQ (binding, Qkeymap))
513
	      noprefix = 1;
514 515 516
	  }
	else if (CONSP (binding))
	  {
517
	    if (EQ (XCAR (binding), idx))
518
	      {
519
		val = XCDR (binding);
520
		if (noprefix && KEYMAPP (val))
521
		  return Qnil;
522 523
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
524
		return get_keyelt (val, autoload);
525
	      }
526 527
	    if (t_ok && EQ (XCAR (binding), Qt))
	      t_binding = XCDR (binding);
528 529 530
	  }
	else if (VECTORP (binding))
	  {
531
	    if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
532
	      {
533
		val = XVECTOR (binding)->contents[XFASTINT (idx)];
534
		if (noprefix && KEYMAPP (val))
535
		  return Qnil;
536 537
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
538
		return get_keyelt (val, autoload);
539
	      }
540
	  }
541 542
	else if (CHAR_TABLE_P (binding))
	  {
543 544 545 546 547 548 549
	    /* Character codes with modifiers
	       are not included in a char-table.
	       All character codes without modifiers are included.  */
	    if (NATNUMP (idx)
		&& ! (XFASTINT (idx)
		      & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
			 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
550 551
	      {
		val = Faref (binding, idx);
552
		if (noprefix && KEYMAPP (val))
553 554 555
		  return Qnil;
		if (CONSP (val))
		  fix_submap_inheritance (map, idx, val);
556
		return get_keyelt (val, autoload);
557 558
	      }
	  }
559 560

	QUIT;
Jim Blandy's avatar
Jim Blandy committed
561
      }
562

563
    return get_keyelt (t_binding, autoload);
564
  }
Jim Blandy's avatar
Jim Blandy committed
565 566 567 568 569 570 571 572 573
}

/* Given OBJECT which was found in a slot in a keymap,
   trace indirect definitions to get the actual definition of that slot.
   An indirect definition is a list of the form
   (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
   and INDEX is the object to look up in KEYMAP to yield the definition.

   Also if OBJECT has a menu string as the first element,
574 575 576 577
   remove that.  Also remove a menu help string as second element.

   If AUTOLOAD is nonzero, load autoloadable keymaps
   that are referred to with indirection.  */
Jim Blandy's avatar
Jim Blandy committed
578 579

Lisp_Object
580
get_keyelt (object, autoload)
Jim Blandy's avatar
Jim Blandy committed
581
     register Lisp_Object object;
582
     int autoload;
Jim Blandy's avatar
Jim Blandy committed
583 584 585
{
  while (1)
    {
586 587 588
      if (!(CONSP (object)))
	/* This is really the value.  */
	return object;
Jim Blandy's avatar
Jim Blandy committed
589

590 591 592 593 594 595 596
      /* If the keymap contents looks like (keymap ...) or (lambda ...)
	 then use itself. */
      else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
	return object;

      /* If the keymap contents looks like (menu-item name . DEFN)
	 or (menu-item name DEFN ...) then use DEFN.
597
	 This is a new format menu item.  */
598
      else if (EQ (XCAR (object), Qmenu_item))
599
	{
600
	  if (CONSP (XCDR (object)))
601
	    {
602 603
	      Lisp_Object tem;

604
	      object = XCDR (XCDR (object));
605
	      tem = object;
606 607
	      if (CONSP (object))
		object = XCAR (object);
608 609 610

	      /* If there's a `:filter FILTER', apply FILTER to the
		 menu-item's definition to get the real definition to
611 612 613
		 use.  Temporarily inhibit GC while evaluating FILTER,
	         because not functions calling get_keyelt are prepared
		 for a GC.  */
614 615 616
	      for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
		if (EQ (XCAR (tem), QCfilter))
		  {
617
		    int count = inhibit_garbage_collection ();
618 619 620 621
		    Lisp_Object filter;
		    filter = XCAR (XCDR (tem));
		    filter = list2 (filter, list2 (Qquote, object));
		    object = menu_item_eval_property (filter);
622
		    unbind_to (count, Qnil);
623 624
		    break;
		  }
625 626
	    }
	  else
627 628
	    /* Invalid keymap */
	    return object;
629 630
	}

631
      /* If the keymap contents looks like (STRING . DEFN), use DEFN.
Jim Blandy's avatar
Jim Blandy committed
632 633
	 Keymap alist elements like (CHAR MENUSTRING . DEFN)
	 will be used by HierarKey menus.  */
634
      else if (STRINGP (XCAR (object)))
635
	{
636
	  object = XCDR (object);
637 638
	  /* Also remove a menu help string, if any,
	     following the menu item name.  */
639 640
	  if (CONSP (object) && STRINGP (XCAR (object)))
	    object = XCDR (object);
641
	  /* Also remove the sublist that caches key equivalences, if any.  */
642
	  if (CONSP (object) && CONSP (XCAR (object)))
643
	    {
644
	      Lisp_Object carcar;
645
	      carcar = XCAR (XCAR (object));
646
	      if (NILP (carcar) || VECTORP (carcar))
647
		object = XCDR (object);
648
	    }
649
	}
Jim Blandy's avatar
Jim Blandy committed
650

651 652
      /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
      else
653
	{
654
	  Lisp_Object map;
655
	  map = get_keymap_1 (Fcar_safe (object), 0, autoload);
656 657
	  return (NILP (map) ? object /* Invalid keymap */
		  : access_keymap (map, Fcdr (object), 0, 0, autoload));
658
	}
Jim Blandy's avatar
Jim Blandy committed
659 660 661
    }
}

662
static Lisp_Object
Jim Blandy's avatar
Jim Blandy committed
663 664 665 666 667
store_in_keymap (keymap, idx, def)
     Lisp_Object keymap;
     register Lisp_Object idx;
     register Lisp_Object def;
{
668
  /* If we are preparing to dump, and DEF is a menu element
669 670
     with a menu item indicator, copy it to ensure it is not pure.  */
  if (CONSP (def) && PURE_P (def)
671 672
      && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
    def = Fcons (XCAR (def), XCDR (def));
673

674
  if (!CONSP (keymap) || ! EQ (XCAR (keymap), Qkeymap))
675 676
    error ("attempt to define a key in a non-keymap");

Jim Blandy's avatar
Jim Blandy committed
677 678 679
  /* If idx is a list (some sort of mouse click, perhaps?),
     the index we want to use is the car of the list, which
     ought to be a symbol.  */
680
  idx = EVENT_HEAD (idx);
Jim Blandy's avatar
Jim Blandy committed
681

682 683
  /* If idx is a symbol, it might have modifiers, which need to
     be put in the canonical order.  */
684
  if (SYMBOLP (idx))
685
    idx = reorder_modifiers (idx);
686 687 688
  else if (INTEGERP (idx))
    /* Clobber the high bits that can be present on a machine
       with more than 24 bits of integer.  */
689
    XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
690 691

  /* Scan the keymap for a binding of idx.  */
Jim Blandy's avatar
Jim Blandy committed
692
  {
693
    Lisp_Object tail;
Jim Blandy's avatar
Jim Blandy committed
694

695 696 697 698 699 700
    /* The cons after which we should insert new bindings.  If the
       keymap has a table element, we record its position here, so new
       bindings will go after it; this way, the table will stay
       towards the front of the alist and character lookups in dense
       keymaps will remain fast.  Otherwise, this just points at the
       front of the keymap.  */
701
    Lisp_Object insertion_point;
Jim Blandy's avatar
Jim Blandy committed
702

703
    insertion_point = keymap;
704
    for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
Jim Blandy's avatar
Jim Blandy committed
705
      {
706
	Lisp_Object elt;
707

708
	elt = XCAR (tail);
709
	if (VECTORP (elt))
710
	  {
711
	    if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
712
	      {
713
		ASET (elt, XFASTINT (idx), def);
714 715 716
		return def;
	      }
	    insertion_point = tail;
717
	  }
718 719
	else if (CHAR_TABLE_P (elt))
	  {
720 721 722 723 724 725 726
	    /* Character codes with modifiers
	       are not included in a char-table.
	       All character codes without modifiers are included.  */
	    if (NATNUMP (idx)
		&& ! (XFASTINT (idx)
		      & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
			 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
727 728 729 730 731 732
	      {
		Faset (elt, idx, def);
		return def;
	      }
	    insertion_point = tail;
	  }
733 734
	else if (CONSP (elt))
	  {
735
	    if (EQ (idx, XCAR (elt)))
736
	      {
737
		XCDR (elt) = def;
738 739
		return def;
	      }
740
	  }
741 742 743 744 745 746
	else if (EQ (elt, Qkeymap))
	  /* If we find a 'keymap' symbol in the spine of KEYMAP,
	     then we must have found the start of a second keymap
	     being used as the tail of KEYMAP, and a binding for IDX
	     should be inserted before it.  */
	  goto keymap_end;
747 748

	QUIT;
Jim Blandy's avatar
Jim Blandy committed
749 750
      }

751 752 753
  keymap_end:
    /* We have scanned the entire keymap, and not found a binding for
       IDX.  Let's add one.  */
754 755
    XCDR (insertion_point)
      = Fcons (Fcons (idx, def), XCDR (insertion_point));
756
  }
757
  
Jim Blandy's avatar
Jim Blandy committed
758 759 760
  return def;
}

761
void
762 763 764
copy_keymap_1 (chartable, idx, elt)
     Lisp_Object chartable, idx, elt;
{
765 766
  if (!SYMBOLP (elt) && ! NILP (Fkeymapp (elt)))
    Faset (chartable, idx, Fcopy_keymap (elt));
767
}
768

Jim Blandy's avatar
Jim Blandy committed
769 770 771 772
DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
  "Return a copy of the keymap KEYMAP.\n\
The copy starts out with the same definitions of KEYMAP,\n\
but changing either the copy or KEYMAP does not affect the other.\n\
Jim Blandy's avatar
Jim Blandy committed
773 774 775
Any key definitions that are subkeymaps are recursively copied.\n\
However, a key definition which is a symbol whose definition is a keymap\n\
is not copied.")
Jim Blandy's avatar
Jim Blandy committed
776 777 778 779 780 781 782
  (keymap)
     Lisp_Object keymap;
{
  register Lisp_Object copy, tail;

  copy = Fcopy_alist (get_keymap (keymap));

783
  for (tail = copy; CONSP (tail); tail = XCDR (tail))
Jim Blandy's avatar
Jim Blandy committed
784
    {
785
      Lisp_Object elt;
Jim Blandy's avatar
Jim Blandy committed
786

787
      elt = XCAR (tail);
788 789
      if (CHAR_TABLE_P (elt))
	{
790
	  Lisp_Object indices[3];
791 792

	  elt = Fcopy_sequence (elt);
793
	  XCAR (tail) = elt;
794

795 796 797
	  map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
	}
      else if (VECTORP (elt))
Jim Blandy's avatar
Jim Blandy committed
798
	{
799
	  int i;
Jim Blandy's avatar
Jim Blandy committed
800

801
	  elt = Fcopy_sequence (elt);
802
	  XCAR (tail) = elt;
Jim Blandy's avatar
Jim Blandy committed
803

804 805 806 807
	  for (i = 0; i < ASIZE (elt); i++)
	    if (!SYMBOLP (AREF (elt, i))
		&& ! NILP (Fkeymapp (AREF (elt, i))))
	      ASET (elt, i, Fcopy_keymap (AREF (elt, i)));
Jim Blandy's avatar
Jim Blandy committed
808
	}
809
      else if (CONSP (elt) && CONSP (XCDR (elt)))
810
	{
811
	  Lisp_Object tem;
812
	  tem = XCDR (elt);
813

814
	  /* Is this a new format menu item.  */
815
	  if (EQ (XCAR (tem),Qmenu_item))
816 817
	    {
	      /* Copy cell with menu-item marker.  */
818 819 820 821
	      XCDR (elt)
		= Fcons (XCAR (tem), XCDR (tem));
	      elt = XCDR (elt);
	      tem = XCDR (elt);
822 823 824
	      if (CONSP (tem))
		{
		  /* Copy cell with menu-item name.  */
825 826 827 828
		  XCDR (elt)
		    = Fcons (XCAR (tem), XCDR (tem));
		  elt = XCDR (elt);
		  tem = XCDR (elt);
829 830 831 832 833
		};
	      if (CONSP (tem))
		{
		  /* Copy cell with binding and if the binding is a keymap,
		     copy that.  */
834 835 836 837
		  XCDR (elt)
		    = Fcons (XCAR (tem), XCDR (tem));
		  elt = XCDR (elt);
		  tem = XCAR (elt);
838
		  if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem))))
839 840 841
		    XCAR (elt) = Fcopy_keymap (tem);
		  tem = XCDR (elt);
		  if (CONSP (tem) && CONSP (XCAR (tem)))
842
		    /* Delete cache for key equivalences.  */
843
		    XCDR (elt) = XCDR (tem);
844 845 846 847 848 849 850
		}
	    }
	  else
	    {
	      /* It may be an old fomat menu item.
		 Skip the optional menu string.
	      */
851
	      if (STRINGP (XCAR (tem)))
852
		{
853
		  /* Copy the cell, since copy-alist didn't go this deep.  */
854 855 856 857
		  XCDR (elt)
		    = Fcons (XCAR (tem), XCDR (tem));
		  elt = XCDR (elt);
		  tem = XCDR (elt);
858
		  /* Also skip the optional menu help string.  */
859
		  if (CONSP (tem) && STRINGP (XCAR (tem)))
860
		    {
861 862 863 864
		      XCDR (elt)
			= Fcons (XCAR (tem), XCDR (tem));
		      elt = XCDR (elt);
		      tem = XCDR (elt);
865 866 867 868
		    }
		  /* There may also be a list that caches key equivalences.
		     Just delete it for the new keymap.  */
		  if (CONSP (tem)
869 870 871 872
		      && CONSP (XCAR (tem))
		      && (NILP (XCAR (XCAR (tem)))
			  || VECTORP (XCAR (XCAR (tem)))))
		    XCDR (elt) = XCDR (tem);
873
		}
874
	      if (CONSP (elt)
875 876 877
		  && ! SYMBOLP (XCDR (elt))
		  && ! NILP (Fkeymapp (XCDR (elt))))
		XCDR (elt) = Fcopy_keymap (XCDR (elt));
878
	    }
879

880
	}
Jim Blandy's avatar
Jim Blandy committed
881
    }
882
	      
Jim Blandy's avatar
Jim Blandy committed
883 884 885
  return copy;
}

Jim Blandy's avatar
Jim Blandy committed
886 887
/* Simple Keymap mutators and accessors.				*/

888 889
/* GC is possible in this function if it autoloads a keymap.  */

Jim Blandy's avatar
Jim Blandy committed
890 891 892 893
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
  "Args KEYMAP, KEY, DEF.  Define key sequence KEY, in KEYMAP, as DEF.\n\
KEYMAP is a keymap.  KEY is a string or a vector of symbols and characters\n\
meaning a sequence of keystrokes and events.\n\
Richard M. Stallman's avatar
Richard M. Stallman committed
894 895
Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
can be included if you use a vector.\n\
Jim Blandy's avatar
Jim Blandy committed
896 897 898 899 900 901 902 903 904 905
DEF is anything that can be a key's definition:\n\
 nil (means key is undefined in this keymap),\n\
 a command (a Lisp function suitable for interactive calling)\n\
 a string (treated as a keyboard macro),\n\
 a keymap (to define a prefix key),\n\
 a symbol.  When the key is looked up, the symbol will stand for its\n\
    function definition, which should at that time be one of the above,\n\
    or another symbol whose function definition is used, etc.\n\
 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
    (DEFN should be a valid definition in its own right),\n\
Jim Blandy's avatar
Jim Blandy committed
906 907 908 909
 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
\n\
If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
the front of KEYMAP.")
Jim Blandy's avatar
Jim Blandy committed
910
  (keymap, key, def)
911
     Lisp_Object keymap;
Jim Blandy's avatar
Jim Blandy committed
912 913 914 915 916 917 918
     Lisp_Object key;
     Lisp_Object def;
{
  register int idx;
  register Lisp_Object c;
  register Lisp_Object cmd;
  int metized = 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
919
  int meta_bit;
Jim Blandy's avatar
Jim Blandy committed
920
  int length;
921
  struct gcpro gcpro1, gcpro2, gcpro3;
Jim Blandy's avatar
Jim Blandy committed
922

923
  keymap = get_keymap_1 (keymap, 1, 1);
Jim Blandy's avatar
Jim Blandy committed
924

925
  if (!VECTORP (key) && !STRINGP (key))
Jim Blandy's avatar
Jim Blandy committed
926 927
    key = wrong_type_argument (Qarrayp, key);

928
  length = XFASTINT (Flength (key));
Jim Blandy's avatar
Jim Blandy committed
929 930 931
  if (length == 0)
    return Qnil;