comparison src/keymap.c @ 250:7e94ea5958e0

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