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