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