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