Initial revision
[bpt/emacs.git] / src / keymap.c
1 /* Manipulation of keymaps
2 Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21 #include "config.h"
22 #include <stdio.h>
23 #undef NULL
24 #include "lisp.h"
25 #include "commands.h"
26 #include "buffer.h"
27 #include "keyboard.h"
28
29 #define min(a, b) ((a) < (b) ? (a) : (b))
30
31 /* Dense keymaps look like (keymap VECTOR . ALIST), where VECTOR is a
32 128-element vector used to look up bindings for ASCII characters,
33 and ALIST is an assoc list for looking up symbols. */
34 #define DENSE_TABLE_SIZE (0200)
35
36 /* Actually allocate storage for these variables */
37
38 Lisp_Object current_global_map; /* Current global keymap */
39
40 Lisp_Object global_map; /* default global key bindings */
41
42 Lisp_Object meta_map; /* The keymap used for globally bound
43 ESC-prefixed default commands */
44
45 Lisp_Object control_x_map; /* The keymap used for globally bound
46 C-x-prefixed default commands */
47
48 /* was MinibufLocalMap */
49 Lisp_Object Vminibuffer_local_map;
50 /* The keymap used by the minibuf for local
51 bindings when spaces are allowed in the
52 minibuf */
53
54 /* was MinibufLocalNSMap */
55 Lisp_Object Vminibuffer_local_ns_map;
56 /* The keymap used by the minibuf for local
57 bindings when spaces are not encouraged
58 in the minibuf */
59
60 /* keymap used for minibuffers when doing completion */
61 /* was MinibufLocalCompletionMap */
62 Lisp_Object Vminibuffer_local_completion_map;
63
64 /* keymap used for minibuffers when doing completion and require a match */
65 /* was MinibufLocalMustMatchMap */
66 Lisp_Object Vminibuffer_local_must_match_map;
67
68 /* Alist of minor mode variables and keymaps. */
69 Lisp_Object Vminor_mode_map_alist;
70
71 /* Keymap mapping ASCII function key sequences onto their preferred forms.
72 Initialized by the terminal-specific lisp files. See DEFVAR for more
73 documentation. */
74 Lisp_Object Vfunction_key_map;
75
76 Lisp_Object Qkeymapp, Qkeymap;
77
78 /* A char over 0200 in a key sequence
79 is equivalent to prefixing with this character. */
80
81 extern Lisp_Object meta_prefix_char;
82
83 void describe_map_tree ();
84 static Lisp_Object describe_buffer_bindings ();
85 static void describe_command ();
86 static void describe_map ();
87 static void describe_alist ();
88 \f
89 /* Keymap object support - constructors and predicates. */
90
91 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 0, 0,
92 "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\
93 VECTOR is a 128-element vector which holds the bindings for the ASCII\n\
94 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
95 mouse events, and any other things that appear in the input stream.\n\
96 All entries in it are initially nil, meaning \"command undefined\".")
97 ()
98 {
99 return Fcons (Qkeymap,
100 Fcons (Fmake_vector (make_number (DENSE_TABLE_SIZE), Qnil),
101 Qnil));
102 }
103
104 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 0, 0,
105 "Construct and return a new sparse-keymap list.\n\
106 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
107 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
108 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
109 Initially the alist is nil.")
110 ()
111 {
112 return Fcons (Qkeymap, Qnil);
113 }
114
115 /* This function is used for installing the standard key bindings
116 at initialization time.
117
118 For example:
119
120 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");
121
122 I haven't extended these to allow the initializing code to bind
123 function keys and mouse events; since they are called by many files,
124 I'd have to fix lots of callers, and nobody right now would be using
125 the new functionality, so it seems like a waste of time. But there's
126 no technical reason not to. -JimB */
127
128 void
129 initial_define_key (keymap, key, defname)
130 Lisp_Object keymap;
131 int key;
132 char *defname;
133 {
134 store_in_keymap (keymap, make_number (key), intern (defname));
135 }
136
137 /* Define character fromchar in map frommap as an alias for character
138 tochar in map tomap. Subsequent redefinitions of the latter WILL
139 affect the former. */
140
141 #if 0
142 void
143 synkey (frommap, fromchar, tomap, tochar)
144 struct Lisp_Vector *frommap, *tomap;
145 int fromchar, tochar;
146 {
147 Lisp_Object v, c;
148 XSET (v, Lisp_Vector, tomap);
149 XFASTINT (c) = tochar;
150 frommap->contents[fromchar] = Fcons (v, c);
151 }
152 #endif /* 0 */
153
154 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
155 "Return t if ARG is a keymap.\n\
156 \n\
157 A keymap is list (keymap . ALIST), a list (keymap VECTOR . ALIST),\n\
158 or a symbol whose function definition is a keymap is itself a keymap.\n\
159 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
160 VECTOR is a 128-element vector of bindings for ASCII characters.")
161 (object)
162 Lisp_Object object;
163 {
164 return (NILP (get_keymap_1 (object, 0)) ? Qnil : Qt);
165 }
166
167 /* Check that OBJECT is a keymap (after dereferencing through any
168 symbols). If it is, return it; otherwise, return nil, or signal an
169 error if ERROR != 0. */
170 Lisp_Object
171 get_keymap_1 (object, error)
172 Lisp_Object object;
173 int error;
174 {
175 register Lisp_Object tem;
176
177 tem = object;
178 while (XTYPE (tem) == Lisp_Symbol && !EQ (tem, Qunbound))
179 {
180 tem = XSYMBOL (tem)->function;
181 QUIT;
182 }
183 if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
184 return tem;
185 if (error)
186 wrong_type_argument (Qkeymapp, object);
187 else
188 return Qnil;
189 }
190
191 Lisp_Object
192 get_keymap (object)
193 Lisp_Object object;
194 {
195 return get_keymap_1 (object, 1);
196 }
197
198
199 /* If KEYMAP is a dense keymap, return the vector from its cadr.
200 Otherwise, return nil. */
201
202 static Lisp_Object
203 keymap_table (keymap)
204 Lisp_Object keymap;
205 {
206 Lisp_Object cadr;
207
208 if (CONSP (XCONS (keymap)->cdr)
209 && XTYPE (cadr = XCONS (XCONS (keymap)->cdr)->car) == Lisp_Vector
210 && XVECTOR (cadr)->size == DENSE_TABLE_SIZE)
211 return cadr;
212 else
213 return Qnil;
214 }
215
216
217 /* Look up IDX in MAP. IDX may be any sort of event.
218 Note that this does only one level of lookup; IDX must
219 be a single event, not a sequence. */
220
221 Lisp_Object
222 access_keymap (map, idx)
223 Lisp_Object map;
224 Lisp_Object idx;
225 {
226 /* If idx is a list (some sort of mouse click, perhaps?),
227 the index we want to use is the car of the list, which
228 ought to be a symbol. */
229 if (EVENT_HAS_PARAMETERS (idx))
230 idx = EVENT_HEAD (idx);
231
232 if (XTYPE (idx) == Lisp_Int
233 && (XINT (idx) < 0 || XINT (idx) >= DENSE_TABLE_SIZE))
234 error ("Command key is not an ASCII character");
235
236 {
237 Lisp_Object table = keymap_table (map);
238
239 /* A dense keymap indexed by a character? */
240 if (XTYPE (idx) == Lisp_Int
241 && ! NILP (table))
242 return XVECTOR (table)->contents[XFASTINT (idx)];
243
244 /* This lookup will not involve a vector reference. */
245 else
246 {
247 /* If idx is a symbol, it might have modifiers, which need to
248 be put in the canonical order. */
249 if (XTYPE (idx) == Lisp_Symbol)
250 idx = reorder_modifiers (idx);
251
252 return Fcdr (Fassq (idx, map));
253 }
254 }
255 }
256
257 /* Given OBJECT which was found in a slot in a keymap,
258 trace indirect definitions to get the actual definition of that slot.
259 An indirect definition is a list of the form
260 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
261 and INDEX is the object to look up in KEYMAP to yield the definition.
262
263 Also if OBJECT has a menu string as the first element,
264 remove that. */
265
266 Lisp_Object
267 get_keyelt (object)
268 register Lisp_Object object;
269 {
270 while (1)
271 {
272 register Lisp_Object map, tem;
273
274 map = get_keymap_1 (Fcar_safe (object), 0);
275 tem = Fkeymapp (map);
276
277 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
278 if (!NILP (tem))
279 object = access_keymap (map, Fcdr (object));
280
281 /* If the keymap contents looks like (STRING . DEFN),
282 use DEFN.
283 Keymap alist elements like (CHAR MENUSTRING . DEFN)
284 will be used by HierarKey menus. */
285 else if (XTYPE (object) == Lisp_Cons
286 && XTYPE (XCONS (object)->car) == Lisp_String)
287 object = XCONS (object)->cdr;
288
289 else
290 /* Anything else is really the value. */
291 return object;
292 }
293 }
294
295 Lisp_Object
296 store_in_keymap (keymap, idx, def)
297 Lisp_Object keymap;
298 register Lisp_Object idx;
299 register Lisp_Object def;
300 {
301 /* If idx is a list (some sort of mouse click, perhaps?),
302 the index we want to use is the car of the list, which
303 ought to be a symbol. */
304 if (EVENT_HAS_PARAMETERS (idx))
305 idx = EVENT_HEAD (idx);
306
307 if (XTYPE (idx) == Lisp_Int
308 && (XINT (idx) < 0 || XINT (idx) >= DENSE_TABLE_SIZE))
309 error ("Command key is a character outside of the ASCII set.");
310
311 {
312 Lisp_Object table = keymap_table (keymap);
313
314 /* A dense keymap indexed by a character? */
315 if (XTYPE (idx) == Lisp_Int && !NILP (table))
316 XVECTOR (table)->contents[XFASTINT (idx)] = def;
317
318 /* Must be a sparse keymap, or a dense keymap indexed by a symbol. */
319 else
320 {
321 /* Point to the pointer to the start of the assoc-list part
322 of the keymap. */
323 register Lisp_Object *assoc_head
324 = (NILP (table)
325 ? & XCONS (keymap)->cdr
326 : & XCONS (XCONS (keymap)->cdr)->cdr);
327 register Lisp_Object defining_pair;
328
329 /* If idx is a symbol, it might have modifiers, which need to
330 be put in the canonical order. */
331 if (XTYPE (idx) == Lisp_Symbol)
332 idx = reorder_modifiers (idx);
333
334 /* Point to the pair where idx is bound, if any. */
335 defining_pair = Fassq (idx, *assoc_head);
336
337 if (NILP (defining_pair))
338 *assoc_head = Fcons (Fcons (idx, def), *assoc_head);
339 else
340 Fsetcdr (defining_pair, def);
341 }
342 }
343
344 return def;
345 }
346
347 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
348 "Return a copy of the keymap KEYMAP.\n\
349 The copy starts out with the same definitions of KEYMAP,\n\
350 but changing either the copy or KEYMAP does not affect the other.\n\
351 Any key definitions that are subkeymaps are recursively copied.\n\
352 However, a key definition which is a symbol whose definition is a keymap\n\
353 is not copied.")
354 (keymap)
355 Lisp_Object keymap;
356 {
357 register Lisp_Object copy, tail;
358
359 copy = Fcopy_alist (get_keymap (keymap));
360 tail = XCONS (copy)->cdr;
361
362 /* If this is a dense keymap, copy the vector. */
363 if (CONSP (tail))
364 {
365 register Lisp_Object table = XCONS (tail)->car;
366
367 if (XTYPE (table) == Lisp_Vector
368 && XVECTOR (table)->size == DENSE_TABLE_SIZE)
369 {
370 register int i;
371
372 table = Fcopy_sequence (table);
373
374 for (i = 0; i < DENSE_TABLE_SIZE; i++)
375 if (XTYPE (XVECTOR (copy)->contents[i]) != Lisp_Symbol)
376 if (! NILP (Fkeymapp (XVECTOR (table)->contents[i])))
377 XVECTOR (table)->contents[i]
378 = Fcopy_keymap (XVECTOR (table)->contents[i]);
379 XCONS (tail)->car = table;
380
381 tail = XCONS (tail)->cdr;
382 }
383 }
384
385 /* Copy the alist portion of the keymap. */
386 while (CONSP (tail))
387 {
388 register Lisp_Object elt;
389
390 elt = XCONS (tail)->car;
391 if (CONSP (elt)
392 && XTYPE (XCONS (elt)->cdr) != Lisp_Symbol
393 && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
394 XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
395
396 tail = XCONS (tail)->cdr;
397 }
398
399 return copy;
400 }
401 \f
402 /* Simple Keymap mutators and accessors. */
403
404 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
405 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
406 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
407 meaning a sequence of keystrokes and events.\n\
408 DEF is anything that can be a key's definition:\n\
409 nil (means key is undefined in this keymap),\n\
410 a command (a Lisp function suitable for interactive calling)\n\
411 a string (treated as a keyboard macro),\n\
412 a keymap (to define a prefix key),\n\
413 a symbol. When the key is looked up, the symbol will stand for its\n\
414 function definition, which should at that time be one of the above,\n\
415 or another symbol whose function definition is used, etc.\n\
416 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
417 (DEFN should be a valid definition in its own right),\n\
418 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
419 \n\
420 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
421 the front of KEYMAP.")
422 (keymap, key, def)
423 register Lisp_Object keymap;
424 Lisp_Object key;
425 Lisp_Object def;
426 {
427 register int idx;
428 register Lisp_Object c;
429 register Lisp_Object tem;
430 register Lisp_Object cmd;
431 int metized = 0;
432 int length;
433
434 keymap = get_keymap (keymap);
435
436 if (XTYPE (key) != Lisp_Vector
437 && XTYPE (key) != Lisp_String)
438 key = wrong_type_argument (Qarrayp, key);
439
440 length = Flength (key);
441 if (length == 0)
442 return Qnil;
443
444 idx = 0;
445 while (1)
446 {
447 c = Faref (key, make_number (idx));
448
449 if (XTYPE (c) == Lisp_Int
450 && XINT (c) >= 0200
451 && !metized)
452 {
453 c = meta_prefix_char;
454 metized = 1;
455 }
456 else
457 {
458 if (XTYPE (c) == Lisp_Int)
459 XSETINT (c, XINT (c) & 0177);
460
461 metized = 0;
462 idx++;
463 }
464
465 if (idx == length)
466 return store_in_keymap (keymap, c, def);
467
468 cmd = get_keyelt (access_keymap (keymap, c));
469
470 if (NILP (cmd))
471 {
472 cmd = Fmake_sparse_keymap ();
473 store_in_keymap (keymap, c, cmd);
474 }
475
476 tem = Fkeymapp (cmd);
477 if (NILP (tem))
478 error ("Key sequence %s uses invalid prefix characters",
479 XSTRING (key)->data);
480
481 keymap = get_keymap (cmd);
482 }
483 }
484
485 /* Value is number if KEY is too long; NIL if valid but has no definition. */
486
487 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 2, 0,
488 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
489 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
490 A number as value means KEY is \"too long\";\n\
491 that is, characters or symbols in it except for the last one\n\
492 fail to be a valid sequence of prefix characters in KEYMAP.\n\
493 The number is how many characters at the front of KEY\n\
494 it takes to reach a non-prefix command.")
495 (keymap, key)
496 register Lisp_Object keymap;
497 Lisp_Object key;
498 {
499 register int idx;
500 register Lisp_Object tem;
501 register Lisp_Object cmd;
502 register Lisp_Object c;
503 int metized = 0;
504 int length;
505
506 keymap = get_keymap (keymap);
507
508 if (XTYPE (key) != Lisp_Vector
509 && XTYPE (key) != Lisp_String)
510 key = wrong_type_argument (Qarrayp, key);
511
512 length = Flength (key);
513 if (length == 0)
514 return keymap;
515
516 idx = 0;
517 while (1)
518 {
519 c = Faref (key, make_number (idx));
520
521 if (XTYPE (c) == Lisp_Int
522 && XINT (c) >= 0200
523 && !metized)
524 {
525 c = meta_prefix_char;
526 metized = 1;
527 }
528 else
529 {
530 if (XTYPE (c) == Lisp_Int)
531 XSETINT (c, XINT (c) & 0177);
532
533 metized = 0;
534 idx++;
535 }
536
537 cmd = get_keyelt (access_keymap (keymap, c));
538 if (idx == length)
539 return cmd;
540
541 tem = Fkeymapp (cmd);
542 if (NILP (tem))
543 return make_number (idx);
544
545 keymap = get_keymap (cmd);
546 QUIT;
547 }
548 }
549
550 /* Append a key to the end of a key sequence. If key_sequence is a
551 string and key is a character, the result will be another string;
552 otherwise, it will be a vector. */
553 Lisp_Object
554 append_key (key_sequence, key)
555 Lisp_Object key_sequence, key;
556 {
557 Lisp_Object args[2];
558
559 args[0] = key_sequence;
560
561 if (XTYPE (key_sequence) == Lisp_String
562 && XTYPE (key) == Lisp_Int)
563 {
564 args[1] = Fchar_to_string (key);
565 return Fconcat (2, args);
566 }
567 else
568 {
569 args[1] = Fcons (key, Qnil);
570 return Fvconcat (2, args);
571 }
572 }
573
574 \f
575 /* Global, local, and minor mode keymap stuff. */
576
577 /* We can't put these variables inside current_minor_maps, since under
578 some systems, static gets macro-defined to be the empty string.
579 Ickypoo. */
580 static Lisp_Object *cmm_modes, *cmm_maps;
581 static int cmm_size;
582
583 /* Store a pointer to an array of the keymaps of the currently active
584 minor modes in *buf, and return the number of maps it contains.
585
586 This function always returns a pointer to the same buffer, and may
587 free or reallocate it, so if you want to keep it for a long time or
588 hand it out to lisp code, copy it. This procedure will be called
589 for every key sequence read, so the nice lispy approach (return a
590 new assoclist, list, what have you) for each invocation would
591 result in a lot of consing over time.
592
593 If we used xrealloc/xmalloc and ran out of memory, they would throw
594 back to the command loop, which would try to read a key sequence,
595 which would call this function again, resulting in an infinite
596 loop. Instead, we'll use realloc/malloc and silently truncate the
597 list, let the key sequence be read, and hope some other piece of
598 code signals the error. */
599 int
600 current_minor_maps (modeptr, mapptr)
601 Lisp_Object **modeptr, **mapptr;
602 {
603 int i = 0;
604 Lisp_Object alist, assoc, var, val;
605
606 for (alist = Vminor_mode_map_alist;
607 CONSP (alist);
608 alist = XCONS (alist)->cdr)
609 if (CONSP (assoc = XCONS (alist)->car)
610 && XTYPE (var = XCONS (assoc)->car) == Lisp_Symbol
611 && ! EQ ((val = find_symbol_value (var)), Qunbound)
612 && ! NILP (val))
613 {
614 if (i >= cmm_size)
615 {
616 Lisp_Object *newmodes, *newmaps;
617
618 if (cmm_maps)
619 {
620 newmodes = (Lisp_Object *) realloc (cmm_modes, cmm_size *= 2);
621 newmaps = (Lisp_Object *) realloc (cmm_maps, cmm_size);
622 }
623 else
624 {
625 newmodes = (Lisp_Object *) malloc (cmm_size = 30);
626 newmaps = (Lisp_Object *) malloc (cmm_size);
627 }
628
629 if (newmaps && newmodes)
630 {
631 cmm_modes = newmodes;
632 cmm_maps = newmaps;
633 }
634 else
635 break;
636 }
637 cmm_modes[i] = var;
638 cmm_maps [i] = XCONS (assoc)->cdr;
639 i++;
640 }
641
642 if (modeptr) *modeptr = cmm_modes;
643 if (mapptr) *mapptr = cmm_maps;
644 return i;
645 }
646
647 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 1, 0,
648 "Return the binding for command KEY in current keymaps.\n\
649 KEY is a string, a sequence of keystrokes.\n\
650 The binding is probably a symbol with a function definition.")
651 (key)
652 Lisp_Object key;
653 {
654 Lisp_Object *maps, value;
655 int nmaps, i;
656
657 nmaps = current_minor_maps (0, &maps);
658 for (i = 0; i < nmaps; i++)
659 if (! NILP (maps[i]))
660 {
661 value = Flookup_key (maps[i], key);
662 if (! NILP (value) && XTYPE (value) != Lisp_Int)
663 return value;
664 }
665
666 if (! NILP (current_buffer->keymap))
667 {
668 value = Flookup_key (current_buffer->keymap, key);
669 if (! NILP (value) && XTYPE (value) != Lisp_Int)
670 return value;
671 }
672
673 value = Flookup_key (current_global_map, key);
674 if (! NILP (value) && XTYPE (value) != Lisp_Int)
675 return value;
676
677 return Qnil;
678 }
679
680 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 1, 0,
681 "Return the binding for command KEYS in current local keymap only.\n\
682 KEYS is a string, a sequence of keystrokes.\n\
683 The binding is probably a symbol with a function definition.")
684 (keys)
685 Lisp_Object keys;
686 {
687 register Lisp_Object map;
688 map = current_buffer->keymap;
689 if (NILP (map))
690 return Qnil;
691 return Flookup_key (map, keys);
692 }
693
694 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 1, 0,
695 "Return the binding for command KEYS in current global keymap only.\n\
696 KEYS is a string, a sequence of keystrokes.\n\
697 The binding is probably a symbol with a function definition.\n\
698 This function's return values are the same as those of lookup-key\n\
699 (which see).")
700 (keys)
701 Lisp_Object keys;
702 {
703 return Flookup_key (current_global_map, keys);
704 }
705
706 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 1, 0,
707 "Find the visible minor mode bindings of KEY.\n\
708 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
709 the symbol which names the minor mode binding KEY, and BINDING is\n\
710 KEY's definition in that mode. In particular, if KEY has no\n\
711 minor-mode bindings, return nil. If the first binding is a\n\
712 non-prefix, all subsequent bindings will be omitted, since they would\n\
713 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
714 that come after prefix bindings.")
715 (key)
716 {
717 Lisp_Object *modes, *maps;
718 int nmaps;
719 Lisp_Object binding;
720 int i, j;
721
722 nmaps = current_minor_maps (&modes, &maps);
723
724 for (i = j = 0; i < nmaps; i++)
725 if (! NILP (maps[i])
726 && ! NILP (binding = Flookup_key (maps[i], key))
727 && XTYPE (binding) != Lisp_Int)
728 {
729 if (! NILP (get_keymap_1 (binding, 0)))
730 maps[j++] = Fcons (modes[i], binding);
731 else if (j == 0)
732 return Fcons (Fcons (modes[i], binding), Qnil);
733 }
734
735 return Flist (j, maps);
736 }
737
738 DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
739 "kSet key globally: \nCSet key %s to command: ",
740 "Give KEY a global binding as COMMAND.\n\
741 COMMAND is a symbol naming an interactively-callable function.\n\
742 KEY is a string representing a sequence of keystrokes.\n\
743 Note that if KEY has a local binding in the current buffer\n\
744 that local binding will continue to shadow any global binding.")
745 (keys, function)
746 Lisp_Object keys, function;
747 {
748 if (XTYPE (keys) != Lisp_Vector
749 && XTYPE (keys) != Lisp_String)
750 keys = wrong_type_argument (Qarrayp, keys);
751
752 Fdefine_key (current_global_map, keys, function);
753 return Qnil;
754 }
755
756 DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2,
757 "kSet key locally: \nCSet key %s locally to command: ",
758 "Give KEY a local binding as COMMAND.\n\
759 COMMAND is a symbol naming an interactively-callable function.\n\
760 KEY is a string representing a sequence of keystrokes.\n\
761 The binding goes in the current buffer's local map,\n\
762 which is shared with other buffers in the same major mode.")
763 (keys, function)
764 Lisp_Object keys, function;
765 {
766 register Lisp_Object map;
767 map = current_buffer->keymap;
768 if (NILP (map))
769 {
770 map = Fmake_sparse_keymap ();
771 current_buffer->keymap = map;
772 }
773
774 if (XTYPE (keys) != Lisp_Vector
775 && XTYPE (keys) != Lisp_String)
776 keys = wrong_type_argument (Qarrayp, keys);
777
778 Fdefine_key (map, keys, function);
779 return Qnil;
780 }
781
782 DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key,
783 1, 1, "kUnset key globally: ",
784 "Remove global binding of KEY.\n\
785 KEY is a string representing a sequence of keystrokes.")
786 (keys)
787 Lisp_Object keys;
788 {
789 return Fglobal_set_key (keys, Qnil);
790 }
791
792 DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1,
793 "kUnset key locally: ",
794 "Remove local binding of KEY.\n\
795 KEY is a string representing a sequence of keystrokes.")
796 (keys)
797 Lisp_Object keys;
798 {
799 if (!NILP (current_buffer->keymap))
800 Flocal_set_key (keys, Qnil);
801 return Qnil;
802 }
803
804 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0,
805 "Define COMMAND as a prefix command.\n\
806 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
807 If a second optional argument MAPVAR is given, the map is stored as\n\
808 its value instead of as COMMAND's value; but COMMAND is still defined\n\
809 as a function.")
810 (name, mapvar)
811 Lisp_Object name, mapvar;
812 {
813 Lisp_Object map;
814 map = Fmake_sparse_keymap ();
815 Ffset (name, map);
816 if (!NILP (mapvar))
817 Fset (mapvar, map);
818 else
819 Fset (name, map);
820 return name;
821 }
822
823 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
824 "Select KEYMAP as the global keymap.")
825 (keymap)
826 Lisp_Object keymap;
827 {
828 keymap = get_keymap (keymap);
829 current_global_map = keymap;
830 return Qnil;
831 }
832
833 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
834 "Select KEYMAP as the local keymap.\n\
835 If KEYMAP is nil, that means no local keymap.")
836 (keymap)
837 Lisp_Object keymap;
838 {
839 if (!NILP (keymap))
840 keymap = get_keymap (keymap);
841
842 current_buffer->keymap = keymap;
843
844 return Qnil;
845 }
846
847 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
848 "Return current buffer's local keymap, or nil if it has none.")
849 ()
850 {
851 return current_buffer->keymap;
852 }
853
854 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
855 "Return the current global keymap.")
856 ()
857 {
858 return current_global_map;
859 }
860
861 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
862 "Return a list of keymaps for the minor modes of the current buffer.")
863 ()
864 {
865 Lisp_Object *maps;
866 int nmaps = current_minor_maps (0, &maps);
867
868 return Flist (nmaps, maps);
869 }
870 \f
871 /* Help functions for describing and documenting keymaps. */
872
873 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
874 1, 1, 0,
875 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
876 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
877 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
878 so that the KEYS increase in length. The first element is (\"\" . KEYMAP).")
879 (startmap)
880 Lisp_Object startmap;
881 {
882 Lisp_Object maps, tail;
883
884 maps = Fcons (Fcons (build_string (""), get_keymap (startmap)), Qnil);
885 tail = maps;
886
887 /* For each map in the list maps,
888 look at any other maps it points to,
889 and stick them at the end if they are not already in the list.
890
891 This is a breadth-first traversal, where tail is the queue of
892 nodes, and maps accumulates a list of all nodes visited. */
893
894 while (!NILP (tail))
895 {
896 register Lisp_Object thisseq = Fcar (Fcar (tail));
897 register Lisp_Object thismap = Fcdr (Fcar (tail));
898 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
899
900 /* Does the current sequence end in the meta-prefix-char? */
901 int is_metized = (XINT (last) >= 0
902 && EQ (Faref (thisseq, last), meta_prefix_char));
903
904 /* Skip the 'keymap element of the list. */
905 thismap = Fcdr (thismap);
906
907 if (CONSP (thismap))
908 {
909 register Lisp_Object table = XCONS (thismap)->car;
910
911 if (XTYPE (table) == Lisp_Vector)
912 {
913 register int i;
914
915 /* Vector keymap. Scan all the elements. */
916 for (i = 0; i < DENSE_TABLE_SIZE; i++)
917 {
918 register Lisp_Object tem;
919 register Lisp_Object cmd;
920
921 cmd = get_keyelt (XVECTOR (table)->contents[i]);
922 if (NILP (cmd)) continue;
923 tem = Fkeymapp (cmd);
924 if (!NILP (tem))
925 {
926 cmd = get_keymap (cmd);
927 /* Ignore keymaps that are already added to maps. */
928 tem = Frassq (cmd, maps);
929 if (NILP (tem))
930 {
931 /* If the last key in thisseq is meta-prefix-char,
932 turn it into a meta-ized keystroke. We know
933 that the event we're about to append is an
934 ascii keystroke. */
935 if (is_metized)
936 {
937 tem = Fcopy_sequence (thisseq);
938 Faset (tem, last, make_number (i | 0200));
939
940 /* This new sequence is the same length as
941 thisseq, so stick it in the list right
942 after this one. */
943 XCONS (tail)->cdr =
944 Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
945 }
946 else
947 {
948 tem = append_key (thisseq, make_number (i));
949 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
950 }
951 }
952 }
953 }
954
955 /* Once finished with the lookup elements of the dense
956 keymap, go on to scan its assoc list. */
957 thismap = XCONS (thismap)->cdr;
958 }
959 }
960
961 /* The rest is an alist. Scan all the alist elements. */
962 while (CONSP (thismap))
963 {
964 Lisp_Object elt = XCONS (thismap)->car;
965
966 /* Ignore elements that are not conses. */
967 if (CONSP (elt))
968 {
969 register Lisp_Object cmd = get_keyelt (XCONS (elt)->cdr);
970 register Lisp_Object tem;
971
972 /* Ignore definitions that aren't keymaps themselves. */
973 tem = Fkeymapp (cmd);
974 if (!NILP (tem))
975 {
976 /* Ignore keymaps that have been seen already. */
977 cmd = get_keymap (cmd);
978 tem = Frassq (cmd, maps);
979 if (NILP (tem))
980 {
981 /* let elt be the event defined by this map entry. */
982 elt = XCONS (elt)->car;
983
984 /* If the last key in thisseq is meta-prefix-char, and
985 this entry is a binding for an ascii keystroke,
986 turn it into a meta-ized keystroke. */
987 if (is_metized && XTYPE (elt) == Lisp_Int)
988 {
989 tem = Fcopy_sequence (thisseq);
990 Faset (tem, last, make_number (XINT (elt) | 0200));
991
992 /* This new sequence is the same length as
993 thisseq, so stick it in the list right
994 after this one. */
995 XCONS (tail)->cdr =
996 Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
997 }
998 else
999 nconc2 (tail,
1000 Fcons (Fcons (append_key (thisseq, elt), cmd),
1001 Qnil));
1002 }
1003 }
1004 }
1005
1006 thismap = XCONS (thismap)->cdr;
1007 }
1008
1009 tail = Fcdr (tail);
1010 }
1011
1012 return maps;
1013 }
1014
1015 Lisp_Object Qsingle_key_description, Qkey_description;
1016
1017 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1018 "Return a pretty description of key-sequence KEYS.\n\
1019 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1020 spaces are put between sequence elements, etc.")
1021 (keys)
1022 Lisp_Object keys;
1023 {
1024 return Fmapconcat (Qsingle_key_description, keys, build_string (" "));
1025 }
1026
1027 char *
1028 push_key_description (c, p)
1029 register unsigned int c;
1030 register char *p;
1031 {
1032 if (c >= 0200)
1033 {
1034 *p++ = 'M';
1035 *p++ = '-';
1036 c -= 0200;
1037 }
1038 if (c < 040)
1039 {
1040 if (c == 033)
1041 {
1042 *p++ = 'E';
1043 *p++ = 'S';
1044 *p++ = 'C';
1045 }
1046 else if (c == Ctl('I'))
1047 {
1048 *p++ = 'T';
1049 *p++ = 'A';
1050 *p++ = 'B';
1051 }
1052 else if (c == Ctl('J'))
1053 {
1054 *p++ = 'L';
1055 *p++ = 'F';
1056 *p++ = 'D';
1057 }
1058 else if (c == Ctl('M'))
1059 {
1060 *p++ = 'R';
1061 *p++ = 'E';
1062 *p++ = 'T';
1063 }
1064 else
1065 {
1066 *p++ = 'C';
1067 *p++ = '-';
1068 if (c > 0 && c <= Ctl ('Z'))
1069 *p++ = c + 0140;
1070 else
1071 *p++ = c + 0100;
1072 }
1073 }
1074 else if (c == 0177)
1075 {
1076 *p++ = 'D';
1077 *p++ = 'E';
1078 *p++ = 'L';
1079 }
1080 else if (c == ' ')
1081 {
1082 *p++ = 'S';
1083 *p++ = 'P';
1084 *p++ = 'C';
1085 }
1086 else
1087 *p++ = c;
1088
1089 return p;
1090 }
1091
1092 DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
1093 "Return a pretty description of command character KEY.\n\
1094 Control characters turn into C-whatever, etc.")
1095 (key)
1096 Lisp_Object key;
1097 {
1098 register unsigned char c;
1099 char tem[6];
1100
1101 if (EVENT_HAS_PARAMETERS (key))
1102 key = EVENT_HEAD (key);
1103
1104 switch (XTYPE (key))
1105 {
1106 case Lisp_Int: /* Normal character */
1107 c = XINT (key) & 0377;
1108 *push_key_description (c, tem) = 0;
1109 return build_string (tem);
1110
1111 case Lisp_Symbol: /* Function key or event-symbol */
1112 return Fsymbol_name (key);
1113
1114 default:
1115 error ("KEY must be an integer, cons, or symbol.");
1116 }
1117 }
1118
1119 char *
1120 push_text_char_description (c, p)
1121 register unsigned int c;
1122 register char *p;
1123 {
1124 if (c >= 0200)
1125 {
1126 *p++ = 'M';
1127 *p++ = '-';
1128 c -= 0200;
1129 }
1130 if (c < 040)
1131 {
1132 *p++ = '^';
1133 *p++ = c + 64; /* 'A' - 1 */
1134 }
1135 else if (c == 0177)
1136 {
1137 *p++ = '^';
1138 *p++ = '?';
1139 }
1140 else
1141 *p++ = c;
1142 return p;
1143 }
1144
1145 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1146 "Return a pretty description of file-character CHAR.\n\
1147 Control characters turn into \"^char\", etc.")
1148 (chr)
1149 Lisp_Object chr;
1150 {
1151 char tem[6];
1152
1153 CHECK_NUMBER (chr, 0);
1154
1155 *push_text_char_description (XINT (chr) & 0377, tem) = 0;
1156
1157 return build_string (tem);
1158 }
1159 \f
1160 /* where-is - finding a command in a set of keymaps. */
1161
1162 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
1163 "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\
1164 If KEYMAP is nil, search only KEYMAP1.\n\
1165 If KEYMAP1 is nil, use the current global map.\n\
1166 \n\
1167 If optional 4th arg FIRSTONLY is non-nil,\n\
1168 return a string representing the first key sequence found,\n\
1169 rather than a list of all possible key sequences.\n\
1170 \n\
1171 If optional 5th arg NOINDIRECT is non-nil, don't follow indirections\n\
1172 to other keymaps or slots. This makes it possible to search for an\n\
1173 indirect definition itself.")
1174 (definition, local_keymap, global_keymap, firstonly, noindirect)
1175 Lisp_Object definition, local_keymap, global_keymap;
1176 Lisp_Object firstonly, noindirect;
1177 {
1178 register Lisp_Object maps;
1179 Lisp_Object found;
1180
1181 if (NILP (global_keymap))
1182 global_keymap = current_global_map;
1183
1184 if (!NILP (local_keymap))
1185 maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap)),
1186 Faccessible_keymaps (get_keymap (global_keymap)));
1187 else
1188 maps = Faccessible_keymaps (get_keymap (global_keymap));
1189
1190 found = Qnil;
1191
1192 for (; !NILP (maps); maps = Fcdr (maps))
1193 {
1194 register this = Fcar (Fcar (maps)); /* Key sequence to reach map */
1195 register map = Fcdr (Fcar (maps)); /* The map that it reaches */
1196 register dense_alist;
1197 register int i = 0;
1198
1199 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1200 [M-CHAR] sequences, check if last character of the sequence
1201 is the meta-prefix char. */
1202 Lisp_Object last = make_number (XINT (Flength (this)) - 1);
1203 int last_is_meta = (XINT (last) >= 0
1204 && EQ (Faref (this, last), meta_prefix_char));
1205
1206 /* Skip the 'keymap element of the list. */
1207 map = Fcdr (map);
1208
1209 /* If the keymap is sparse, map traverses the alist to the end.
1210
1211 If the keymap is dense, we set map to the vector and
1212 dense_alist to the assoc-list portion of the keymap. When we
1213 are finished dealing with the vector portion, we set map to
1214 dense_alist, and handle the rest like a sparse keymap. */
1215 if (XTYPE (XCONS (map)->car) == Lisp_Vector)
1216 {
1217 dense_alist = XCONS (map)->cdr;
1218 map = XCONS (map)->car;
1219 }
1220
1221 while (1)
1222 {
1223 register Lisp_Object key, binding, sequence;
1224
1225 QUIT;
1226 if (XTYPE (map) == Lisp_Vector)
1227 {
1228 /* In a vector, look at each element. */
1229 binding = XVECTOR (map)->contents[i];
1230 XFASTINT (key) = i;
1231 i++;
1232
1233 /* If we've just finished scanning a vector, switch map to
1234 the assoc-list at the end of the vector. */
1235 if (i >= DENSE_TABLE_SIZE)
1236 map = dense_alist;
1237 }
1238 else if (CONSP (map))
1239 {
1240 /* In an alist, ignore elements that aren't conses. */
1241 if (! CONSP (XCONS (map)->car))
1242 {
1243 /* Ignore other elements. */
1244 map = Fcdr (map);
1245 continue;
1246 }
1247 binding = Fcdr (Fcar (map));
1248 key = Fcar (Fcar (map));
1249 map = Fcdr (map);
1250 }
1251 else
1252 break;
1253
1254 /* Search through indirections unless that's not wanted. */
1255 if (NILP (noindirect))
1256 binding = get_keyelt (binding);
1257
1258 /* End this iteration if this element does not match
1259 the target. */
1260
1261 if (XTYPE (definition) == Lisp_Cons)
1262 {
1263 Lisp_Object tem;
1264 tem = Fequal (binding, definition);
1265 if (NILP (tem))
1266 continue;
1267 }
1268 else
1269 if (!EQ (binding, definition))
1270 continue;
1271
1272 /* We have found a match.
1273 Construct the key sequence where we found it. */
1274 if (XTYPE (key) == Lisp_Int && last_is_meta)
1275 {
1276 sequence = Fcopy_sequence (this);
1277 Faset (sequence, last, make_number (XINT (key) | 0200));
1278 }
1279 else
1280 sequence = append_key (this, key);
1281
1282 /* Verify that this key binding is not shadowed by another
1283 binding for the same key, before we say it exists.
1284
1285 Mechanism: look for local definition of this key and if
1286 it is defined and does not match what we found then
1287 ignore this key.
1288
1289 Either nil or number as value from Flookup_key
1290 means undefined. */
1291 if (!NILP (local_keymap))
1292 {
1293 binding = Flookup_key (local_keymap, sequence);
1294 if (!NILP (binding) && XTYPE (binding) != Lisp_Int)
1295 {
1296 if (XTYPE (definition) == Lisp_Cons)
1297 {
1298 Lisp_Object tem;
1299 tem = Fequal (binding, definition);
1300 if (NILP (tem))
1301 continue;
1302 }
1303 else
1304 if (!EQ (binding, definition))
1305 continue;
1306 }
1307 }
1308
1309 /* It is a true unshadowed match. Record it. */
1310
1311 if (!NILP (firstonly))
1312 return sequence;
1313 found = Fcons (sequence, found);
1314 }
1315 }
1316 return Fnreverse (found);
1317 }
1318
1319 /* Return a string listing the keys and buttons that run DEFINITION. */
1320
1321 static Lisp_Object
1322 where_is_string (definition)
1323 Lisp_Object definition;
1324 {
1325 register Lisp_Object keys, keys1;
1326
1327 keys = Fwhere_is_internal (definition,
1328 current_buffer->keymap, Qnil, Qnil, Qnil);
1329 keys1 = Fmapconcat (Qkey_description, keys, build_string (", "));
1330
1331 return keys1;
1332 }
1333
1334 DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ",
1335 "Print message listing key sequences that invoke specified command.\n\
1336 Argument is a command definition, usually a symbol with a function definition.")
1337 (definition)
1338 Lisp_Object definition;
1339 {
1340 register Lisp_Object string;
1341
1342 CHECK_SYMBOL (definition, 0);
1343 string = where_is_string (definition);
1344
1345 if (XSTRING (string)->size)
1346 message ("%s is on %s", XSYMBOL (definition)->name->data,
1347 XSTRING (string)->data);
1348 else
1349 message ("%s is not on any key", XSYMBOL (definition)->name->data);
1350 return Qnil;
1351 }
1352 \f
1353 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
1354
1355 DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 0, "",
1356 "Show a list of all defined keys, and their definitions.\n\
1357 The list is put in a buffer, which is displayed.")
1358 ()
1359 {
1360 register Lisp_Object thisbuf;
1361 XSET (thisbuf, Lisp_Buffer, current_buffer);
1362 internal_with_output_to_temp_buffer ("*Help*",
1363 describe_buffer_bindings,
1364 thisbuf);
1365 return Qnil;
1366 }
1367
1368 static Lisp_Object
1369 describe_buffer_bindings (descbuf)
1370 Lisp_Object descbuf;
1371 {
1372 register Lisp_Object start1, start2;
1373
1374 char *heading
1375 = "key binding\n--- -------\n";
1376
1377 Fset_buffer (Vstandard_output);
1378
1379 {
1380 int i, nmaps;
1381 Lisp_Object *modes, *maps;
1382
1383 nmaps = current_minor_maps (&modes, &maps);
1384 for (i = 0; i < nmaps; i++)
1385 {
1386 if (XTYPE (modes[i]) == Lisp_Symbol)
1387 {
1388 insert_char ('`');
1389 insert_string (XSYMBOL (modes[i])->name->data);
1390 insert_char ('\'');
1391 }
1392 else
1393 insert_string ("Strangely Named");
1394 insert_string (" Minor Mode Bindings:\n");
1395 insert_string (heading);
1396 describe_map_tree (maps[i], 0, Qnil);
1397 insert_char ('\n');
1398 }
1399 }
1400
1401 start1 = XBUFFER (descbuf)->keymap;
1402 if (!NILP (start1))
1403 {
1404 insert_string ("Local Bindings:\n");
1405 insert_string (heading);
1406 describe_map_tree (start1, 0, Qnil);
1407 insert_string ("\n");
1408 }
1409
1410 insert_string ("Global Bindings:\n");
1411 insert_string (heading);
1412
1413 describe_map_tree (current_global_map, 0, XBUFFER (descbuf)->keymap);
1414
1415 Fset_buffer (descbuf);
1416 return Qnil;
1417 }
1418
1419 /* Insert a desription of the key bindings in STARTMAP,
1420 followed by those of all maps reachable through STARTMAP.
1421 If PARTIAL is nonzero, omit certain "uninteresting" commands
1422 (such as `undefined').
1423 If SHADOW is non-nil, it is another map;
1424 don't mention keys which would be shadowed by it. */
1425
1426 void
1427 describe_map_tree (startmap, partial, shadow)
1428 Lisp_Object startmap, shadow;
1429 int partial;
1430 {
1431 register Lisp_Object elt, sh;
1432 Lisp_Object maps;
1433 struct gcpro gcpro1;
1434
1435 maps = Faccessible_keymaps (startmap);
1436 GCPRO1 (maps);
1437
1438 for (; !NILP (maps); maps = Fcdr (maps))
1439 {
1440 elt = Fcar (maps);
1441 sh = Fcar (elt);
1442
1443 /* If there is no shadow keymap given, don't shadow. */
1444 if (NILP (shadow))
1445 sh = Qnil;
1446
1447 /* If the sequence by which we reach this keymap is zero-length,
1448 then the shadow map for this keymap is just SHADOW. */
1449 else if ((XTYPE (sh) == Lisp_String
1450 && XSTRING (sh)->size == 0)
1451 || (XTYPE (sh) == Lisp_Vector
1452 && XVECTOR (sh)->size == 0))
1453 sh = shadow;
1454
1455 /* If the sequence by which we reach this keymap actually has
1456 some elements, then the sequence's definition in SHADOW is
1457 what we should use. */
1458 else
1459 {
1460 sh = Flookup_key (shadow, Fcar (elt));
1461 if (XTYPE (sh) == Lisp_Int)
1462 sh = Qnil;
1463 }
1464
1465 /* If sh is null (meaning that the current map is not shadowed),
1466 or a keymap (meaning that bindings from the current map might
1467 show through), describe the map. Otherwise, sh is a command
1468 that completely shadows the current map, and we shouldn't
1469 bother. */
1470 if (NILP (sh) || !NILP (Fkeymapp (sh)))
1471 describe_map (Fcdr (elt), Fcar (elt), partial, sh);
1472 }
1473
1474 UNGCPRO;
1475 }
1476
1477 static void
1478 describe_command (definition)
1479 Lisp_Object definition;
1480 {
1481 register Lisp_Object tem1;
1482
1483 Findent_to (make_number (16), make_number (1));
1484
1485 if (XTYPE (definition) == Lisp_Symbol)
1486 {
1487 XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
1488 insert1 (tem1);
1489 insert_string ("\n");
1490 }
1491 else
1492 {
1493 tem1 = Fkeymapp (definition);
1494 if (!NILP (tem1))
1495 insert_string ("Prefix Command\n");
1496 else
1497 insert_string ("??\n");
1498 }
1499 }
1500
1501 /* Describe the contents of map MAP, assuming that this map itself is
1502 reached by the sequence of prefix keys KEYS (a string or vector).
1503 PARTIAL, SHADOW is as in `describe_map_tree' above. */
1504
1505 static void
1506 describe_map (map, keys, partial, shadow)
1507 Lisp_Object map, keys;
1508 int partial;
1509 Lisp_Object shadow;
1510 {
1511 register Lisp_Object keysdesc;
1512
1513 if (!NILP (keys) && Flength (keys) > 0)
1514 keysdesc = concat2 (Fkey_description (keys),
1515 build_string (" "));
1516 else
1517 keysdesc = Qnil;
1518
1519 /* Skip the 'keymap element of the list. */
1520 map = Fcdr (map);
1521
1522 /* If this is a dense keymap, take care of the table. */
1523 if (CONSP (map)
1524 && XTYPE (XCONS (map)->car) == Lisp_Vector)
1525 {
1526 describe_vector (XCONS (map)->car, keysdesc, describe_command,
1527 partial, shadow);
1528 map = XCONS (map)->cdr;
1529 }
1530
1531 /* Now map is an alist. */
1532 describe_alist (map, keysdesc, describe_command, partial, shadow);
1533 }
1534
1535 /* Insert a description of ALIST into the current buffer.
1536 Note that ALIST is just a plain association list, not a keymap. */
1537
1538 static void
1539 describe_alist (alist, elt_prefix, elt_describer, partial, shadow)
1540 register Lisp_Object alist;
1541 Lisp_Object elt_prefix;
1542 int (*elt_describer) ();
1543 int partial;
1544 Lisp_Object shadow;
1545 {
1546 Lisp_Object this;
1547 Lisp_Object tem1, tem2 = Qnil;
1548 Lisp_Object suppress;
1549 Lisp_Object kludge;
1550 int first = 1;
1551 struct gcpro gcpro1, gcpro2, gcpro3;
1552
1553 if (partial)
1554 suppress = intern ("suppress-keymap");
1555
1556 /* This vector gets used to present single keys to Flookup_key. Since
1557 that is done once per alist element, we don't want to cons up a
1558 fresh vector every time. */
1559 kludge = Fmake_vector (make_number (1), Qnil);
1560
1561 GCPRO3 (elt_prefix, tem2, kludge);
1562
1563 for (; CONSP (alist); alist = Fcdr (alist))
1564 {
1565 QUIT;
1566 tem1 = Fcar_safe (Fcar (alist));
1567 tem2 = get_keyelt (Fcdr_safe (Fcar (alist)));
1568
1569 /* Don't show undefined commands or suppressed commands. */
1570 if (NILP (tem2)) continue;
1571 if (XTYPE (tem2) == Lisp_Symbol && partial)
1572 {
1573 this = Fget (tem2, suppress);
1574 if (!NILP (this))
1575 continue;
1576 }
1577
1578 /* Don't show a command that isn't really visible
1579 because a local definition of the same key shadows it. */
1580
1581 if (!NILP (shadow))
1582 {
1583 Lisp_Object tem;
1584
1585 XVECTOR (kludge)->contents[0] = tem1;
1586 tem = Flookup_key (shadow, kludge);
1587 if (!NILP (tem)) continue;
1588 }
1589
1590 if (first)
1591 {
1592 insert ("\n", 1);
1593 first = 0;
1594 }
1595
1596 if (!NILP (elt_prefix))
1597 insert1 (elt_prefix);
1598
1599 /* THIS gets the string to describe the character TEM1. */
1600 this = Fsingle_key_description (tem1);
1601 insert1 (this);
1602
1603 /* Print a description of the definition of this character.
1604 elt_describer will take care of spacing out far enough
1605 for alignment purposes. */
1606 (*elt_describer) (tem2);
1607 }
1608
1609 UNGCPRO;
1610 }
1611
1612 static int
1613 describe_vector_princ (elt)
1614 Lisp_Object elt;
1615 {
1616 Fprinc (elt, Qnil);
1617 }
1618
1619 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
1620 "Print on `standard-output' a description of contents of VECTOR.\n\
1621 This is text showing the elements of vector matched against indices.")
1622 (vector)
1623 Lisp_Object vector;
1624 {
1625 CHECK_VECTOR (vector, 0);
1626 describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil, Qnil);
1627 }
1628
1629 describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
1630 register Lisp_Object vector;
1631 Lisp_Object elt_prefix;
1632 int (*elt_describer) ();
1633 int partial;
1634 Lisp_Object shadow;
1635 {
1636 Lisp_Object this;
1637 Lisp_Object dummy;
1638 Lisp_Object tem1, tem2;
1639 register int i;
1640 Lisp_Object suppress;
1641 Lisp_Object kludge;
1642 int first = 1;
1643 struct gcpro gcpro1, gcpro2, gcpro3;
1644
1645 tem1 = Qnil;
1646
1647 /* This vector gets used to present single keys to Flookup_key. Since
1648 that is done once per vector element, we don't want to cons up a
1649 fresh vector every time. */
1650 kludge = Fmake_vector (make_number (1), Qnil);
1651 GCPRO3 (elt_prefix, tem1, kludge);
1652
1653 if (partial)
1654 suppress = intern ("suppress-keymap");
1655
1656 for (i = 0; i < DENSE_TABLE_SIZE; i++)
1657 {
1658 QUIT;
1659 tem1 = get_keyelt (XVECTOR (vector)->contents[i]);
1660
1661 if (NILP (tem1)) continue;
1662
1663 /* Don't mention suppressed commands. */
1664 if (XTYPE (tem1) == Lisp_Symbol && partial)
1665 {
1666 this = Fget (tem1, suppress);
1667 if (!NILP (this))
1668 continue;
1669 }
1670
1671 /* If this command in this map is shadowed by some other map,
1672 ignore it. */
1673 if (!NILP (shadow))
1674 {
1675 Lisp_Object tem;
1676
1677 XVECTOR (kludge)->contents[0] = make_number (i);
1678 tem = Flookup_key (shadow, kludge);
1679
1680 if (!NILP (tem)) continue;
1681 }
1682
1683 if (first)
1684 {
1685 insert ("\n", 1);
1686 first = 0;
1687 }
1688
1689 /* Output the prefix that applies to every entry in this map. */
1690 if (!NILP (elt_prefix))
1691 insert1 (elt_prefix);
1692
1693 /* Get the string to describe the character I, and print it. */
1694 XFASTINT (dummy) = i;
1695
1696 /* THIS gets the string to describe the character DUMMY. */
1697 this = Fsingle_key_description (dummy);
1698 insert1 (this);
1699
1700 /* Find all consecutive characters that have the same definition. */
1701 while (i + 1 < DENSE_TABLE_SIZE
1702 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]),
1703 EQ (tem2, tem1)))
1704 i++;
1705
1706 /* If we have a range of more than one character,
1707 print where the range reaches to. */
1708
1709 if (i != XINT (dummy))
1710 {
1711 insert (" .. ", 4);
1712 if (!NILP (elt_prefix))
1713 insert1 (elt_prefix);
1714
1715 XFASTINT (dummy) = i;
1716 insert1 (Fsingle_key_description (dummy));
1717 }
1718
1719 /* Print a description of the definition of this character.
1720 elt_describer will take care of spacing out far enough
1721 for alignment purposes. */
1722 (*elt_describer) (tem1);
1723 }
1724
1725 UNGCPRO;
1726 }
1727 \f
1728 /* Apropos - finding all symbols whose names match a regexp. */
1729 Lisp_Object apropos_predicate;
1730 Lisp_Object apropos_accumulate;
1731
1732 static void
1733 apropos_accum (symbol, string)
1734 Lisp_Object symbol, string;
1735 {
1736 register Lisp_Object tem;
1737
1738 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
1739 if (!NILP (tem) && !NILP (apropos_predicate))
1740 tem = call1 (apropos_predicate, symbol);
1741 if (!NILP (tem))
1742 apropos_accumulate = Fcons (symbol, apropos_accumulate);
1743 }
1744
1745 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
1746 "Show all symbols whose names contain match for REGEXP.\n\
1747 If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\
1748 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
1749 Return list of symbols found.")
1750 (string, pred)
1751 Lisp_Object string, pred;
1752 {
1753 struct gcpro gcpro1, gcpro2;
1754 CHECK_STRING (string, 0);
1755 apropos_predicate = pred;
1756 GCPRO2 (apropos_predicate, apropos_accumulate);
1757 apropos_accumulate = Qnil;
1758 map_obarray (Vobarray, apropos_accum, string);
1759 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
1760 UNGCPRO;
1761 return apropos_accumulate;
1762 }
1763 \f
1764 syms_of_keymap ()
1765 {
1766 Lisp_Object tem;
1767
1768 Qkeymap = intern ("keymap");
1769 staticpro (&Qkeymap);
1770
1771 /* Initialize the keymaps standardly used.
1772 Each one is the value of a Lisp variable, and is also
1773 pointed to by a C variable */
1774
1775 global_map = Fmake_keymap ();
1776 Fset (intern ("global-map"), global_map);
1777
1778 meta_map = Fmake_keymap ();
1779 Fset (intern ("esc-map"), meta_map);
1780 Ffset (intern ("ESC-prefix"), meta_map);
1781
1782 control_x_map = Fmake_keymap ();
1783 Fset (intern ("ctl-x-map"), control_x_map);
1784 Ffset (intern ("Control-X-prefix"), control_x_map);
1785
1786 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
1787 "Default keymap to use when reading from the minibuffer.");
1788 Vminibuffer_local_map = Fmake_sparse_keymap ();
1789
1790 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
1791 "Local keymap for the minibuffer when spaces are not allowed.");
1792 Vminibuffer_local_ns_map = Fmake_sparse_keymap ();
1793
1794 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
1795 "Local keymap for minibuffer input with completion.");
1796 Vminibuffer_local_completion_map = Fmake_sparse_keymap ();
1797
1798 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
1799 "Local keymap for minibuffer input with completion, for exact match.");
1800 Vminibuffer_local_must_match_map = Fmake_sparse_keymap ();
1801
1802 current_global_map = global_map;
1803
1804 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
1805 "Alist of keymaps to use for minor modes.\n\
1806 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
1807 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
1808 If two active keymaps bind the same key, the keymap appearing earlier\n\
1809 in the list takes precedence.");
1810 Vminor_mode_map_alist = Qnil;
1811
1812 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
1813 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
1814 This allows Emacs to recognize function keys sent from ASCII\n\
1815 terminals at any point in a key sequence.\n\
1816 \n\
1817 The read-key-sequence function replaces subsequences bound by\n\
1818 function-key-map with their bindings. When the current local and global\n\
1819 keymaps have no binding for the current key sequence but\n\
1820 function-key-map binds a suffix of the sequence to a vector,\n\
1821 read-key-sequence replaces the matching suffix with its binding, and\n\
1822 continues with the new sequence.\n\
1823 \n\
1824 For example, suppose function-key-map binds `ESC O P' to [pf1].\n\
1825 Typing `ESC O P' to read-key-sequence would return [pf1]. Typing\n\
1826 `C-x ESC O P' would return [?\C-x pf1]. If [pf1] were a prefix\n\
1827 key, typing `ESC O P x' would return [pf1 x].");
1828 Vfunction_key_map = Fmake_sparse_keymap ();
1829
1830 Qsingle_key_description = intern ("single-key-description");
1831 staticpro (&Qsingle_key_description);
1832
1833 Qkey_description = intern ("key-description");
1834 staticpro (&Qkey_description);
1835
1836 Qkeymapp = intern ("keymapp");
1837 staticpro (&Qkeymapp);
1838
1839 defsubr (&Skeymapp);
1840 defsubr (&Smake_keymap);
1841 defsubr (&Smake_sparse_keymap);
1842 defsubr (&Scopy_keymap);
1843 defsubr (&Skey_binding);
1844 defsubr (&Slocal_key_binding);
1845 defsubr (&Sglobal_key_binding);
1846 defsubr (&Sminor_mode_key_binding);
1847 defsubr (&Sglobal_set_key);
1848 defsubr (&Slocal_set_key);
1849 defsubr (&Sdefine_key);
1850 defsubr (&Slookup_key);
1851 defsubr (&Sglobal_unset_key);
1852 defsubr (&Slocal_unset_key);
1853 defsubr (&Sdefine_prefix_command);
1854 defsubr (&Suse_global_map);
1855 defsubr (&Suse_local_map);
1856 defsubr (&Scurrent_local_map);
1857 defsubr (&Scurrent_global_map);
1858 defsubr (&Scurrent_minor_mode_maps);
1859 defsubr (&Saccessible_keymaps);
1860 defsubr (&Skey_description);
1861 defsubr (&Sdescribe_vector);
1862 defsubr (&Ssingle_key_description);
1863 defsubr (&Stext_char_description);
1864 defsubr (&Swhere_is_internal);
1865 defsubr (&Swhere_is);
1866 defsubr (&Sdescribe_bindings);
1867 defsubr (&Sapropos_internal);
1868 }
1869
1870 keys_of_keymap ()
1871 {
1872 Lisp_Object tem;
1873
1874 initial_define_key (global_map, 033, "ESC-prefix");
1875 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
1876 }