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