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