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