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