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