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