]> code.delx.au - gnu-emacs/blob - src/keymap.c
(scmp): Use unsigned chars, to avoid confusing DOWNCASE.
[gnu-emacs] / src / keymap.c
1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86, 87, 88, 93, 94 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 #include "termhooks.h"
29 #include "blockinput.h"
30
31 #define min(a, b) ((a) < (b) ? (a) : (b))
32
33 /* The number of elements in keymap vectors. */
34 #define DENSE_TABLE_SIZE (0200)
35
36 /* Actually allocate storage for these variables */
37
38 Lisp_Object current_global_map; /* Current global keymap */
39
40 Lisp_Object global_map; /* default global key bindings */
41
42 Lisp_Object meta_map; /* The keymap used for globally bound
43 ESC-prefixed default commands */
44
45 Lisp_Object control_x_map; /* The keymap used for globally bound
46 C-x-prefixed default commands */
47
48 /* was MinibufLocalMap */
49 Lisp_Object Vminibuffer_local_map;
50 /* The keymap used by the minibuf for local
51 bindings when spaces are allowed in the
52 minibuf */
53
54 /* was MinibufLocalNSMap */
55 Lisp_Object Vminibuffer_local_ns_map;
56 /* The keymap used by the minibuf for local
57 bindings when spaces are not encouraged
58 in the minibuf */
59
60 /* keymap used for minibuffers when doing completion */
61 /* was MinibufLocalCompletionMap */
62 Lisp_Object Vminibuffer_local_completion_map;
63
64 /* keymap used for minibuffers when doing completion and require a match */
65 /* was MinibufLocalMustMatchMap */
66 Lisp_Object Vminibuffer_local_must_match_map;
67
68 /* Alist of minor mode variables and keymaps. */
69 Lisp_Object Vminor_mode_map_alist;
70
71 /* Keymap mapping ASCII function key sequences onto their preferred forms.
72 Initialized by the terminal-specific lisp files. See DEFVAR for more
73 documentation. */
74 Lisp_Object Vfunction_key_map;
75
76 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii;
77
78 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
79 in a string key sequence is equivalent to prefixing with this
80 character. */
81 extern Lisp_Object meta_prefix_char;
82
83 extern Lisp_Object Voverriding_local_map;
84
85 void describe_map_tree ();
86 static Lisp_Object define_as_prefix ();
87 static Lisp_Object describe_buffer_bindings ();
88 static void describe_command ();
89 static void describe_map ();
90 \f
91 /* Keymap object support - constructors and predicates. */
92
93 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
94 "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\
95 VECTOR is a vector which holds the bindings for the ASCII\n\
96 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
97 mouse events, and any other things that appear in the input stream.\n\
98 All entries in it are initially nil, meaning \"command undefined\".\n\n\
99 The optional arg STRING supplies a menu name for the keymap\n\
100 in case you use it as a menu with `x-popup-menu'.")
101 (string)
102 Lisp_Object string;
103 {
104 Lisp_Object tail;
105 if (!NILP (string))
106 tail = Fcons (string, Qnil);
107 else
108 tail = Qnil;
109 return Fcons (Qkeymap,
110 Fcons (Fmake_vector (make_number (DENSE_TABLE_SIZE), Qnil),
111 tail));
112 }
113
114 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
115 "Construct and return a new sparse-keymap list.\n\
116 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
117 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
118 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
119 Initially the alist is nil.\n\n\
120 The optional arg STRING supplies a menu name for the keymap\n\
121 in case you use it as a menu with `x-popup-menu'.")
122 (string)
123 Lisp_Object string;
124 {
125 if (!NILP (string))
126 return Fcons (Qkeymap, Fcons (string, Qnil));
127 return Fcons (Qkeymap, Qnil);
128 }
129
130 /* This function is used for installing the standard key bindings
131 at initialization time.
132
133 For example:
134
135 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
136
137 void
138 initial_define_key (keymap, key, defname)
139 Lisp_Object keymap;
140 int key;
141 char *defname;
142 {
143 store_in_keymap (keymap, make_number (key), intern (defname));
144 }
145
146 void
147 initial_define_lispy_key (keymap, keyname, defname)
148 Lisp_Object keymap;
149 char *keyname;
150 char *defname;
151 {
152 store_in_keymap (keymap, intern (keyname), intern (defname));
153 }
154
155 /* Define character fromchar in map frommap as an alias for character
156 tochar in map tomap. Subsequent redefinitions of the latter WILL
157 affect the former. */
158
159 #if 0
160 void
161 synkey (frommap, fromchar, tomap, tochar)
162 struct Lisp_Vector *frommap, *tomap;
163 int fromchar, tochar;
164 {
165 Lisp_Object v, c;
166 XSET (v, Lisp_Vector, tomap);
167 XFASTINT (c) = tochar;
168 frommap->contents[fromchar] = Fcons (v, c);
169 }
170 #endif /* 0 */
171
172 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
173 "Return t if ARG is a keymap.\n\
174 \n\
175 A keymap is a list (keymap . ALIST),\n\
176 or a symbol whose function definition is itself a keymap.\n\
177 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
178 a vector of densely packed bindings for small character codes\n\
179 is also allowed as an element.")
180 (object)
181 Lisp_Object object;
182 {
183 return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
184 }
185
186 /* Check that OBJECT is a keymap (after dereferencing through any
187 symbols). If it is, return it.
188
189 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
190 is an autoload form, do the autoload and try again.
191 If AUTOLOAD is nonzero, callers must assume GC is possible.
192
193 ERROR controls how we respond if OBJECT isn't a keymap.
194 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
195
196 Note that most of the time, we don't want to pursue autoloads.
197 Functions like Faccessible_keymaps which scan entire keymap trees
198 shouldn't load every autoloaded keymap. I'm not sure about this,
199 but it seems to me that only read_key_sequence, Flookup_key, and
200 Fdefine_key should cause keymaps to be autoloaded. */
201
202 Lisp_Object
203 get_keymap_1 (object, error, autoload)
204 Lisp_Object object;
205 int error, autoload;
206 {
207 Lisp_Object tem;
208
209 autoload_retry:
210 tem = indirect_function (object);
211 if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
212 return tem;
213
214 /* Should we do an autoload? Autoload forms for keymaps have
215 Qkeymap as their fifth element. */
216 if (autoload
217 && SYMBOLP (object)
218 && CONSP (tem)
219 && EQ (XCONS (tem)->car, Qautoload))
220 {
221 Lisp_Object tail;
222
223 tail = Fnth (make_number (4), tem);
224 if (EQ (tail, Qkeymap))
225 {
226 struct gcpro gcpro1, gcpro2;
227
228 GCPRO2 (tem, object);
229 do_autoload (tem, object);
230 UNGCPRO;
231
232 goto autoload_retry;
233 }
234 }
235
236 if (error)
237 wrong_type_argument (Qkeymapp, object);
238 else
239 return Qnil;
240 }
241
242
243 /* Follow any symbol chaining, and return the keymap denoted by OBJECT.
244 If OBJECT doesn't denote a keymap at all, signal an error. */
245 Lisp_Object
246 get_keymap (object)
247 Lisp_Object object;
248 {
249 return get_keymap_1 (object, 1, 0);
250 }
251
252
253 /* Look up IDX in MAP. IDX may be any sort of event.
254 Note that this does only one level of lookup; IDX must be a single
255 event, not a sequence.
256
257 If T_OK is non-zero, bindings for Qt are treated as default
258 bindings; any key left unmentioned by other tables and bindings is
259 given the binding of Qt.
260
261 If T_OK is zero, bindings for Qt are not treated specially.
262
263 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
264
265 Lisp_Object
266 access_keymap (map, idx, t_ok, noinherit)
267 Lisp_Object map;
268 Lisp_Object idx;
269 int t_ok;
270 int noinherit;
271 {
272 int noprefix = 0;
273 Lisp_Object val;
274
275 /* If idx is a list (some sort of mouse click, perhaps?),
276 the index we want to use is the car of the list, which
277 ought to be a symbol. */
278 idx = EVENT_HEAD (idx);
279
280 /* If idx is a symbol, it might have modifiers, which need to
281 be put in the canonical order. */
282 if (SYMBOLP (idx))
283 idx = reorder_modifiers (idx);
284 else if (INTEGERP (idx))
285 /* Clobber the high bits that can be present on a machine
286 with more than 24 bits of integer. */
287 XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1));
288
289 {
290 Lisp_Object tail;
291 Lisp_Object t_binding;
292
293 t_binding = Qnil;
294 for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr)
295 {
296 Lisp_Object binding;
297
298 binding = XCONS (tail)->car;
299 switch (XTYPE (binding))
300 {
301 case Lisp_Symbol:
302 /* If NOINHERIT, stop finding prefix definitions
303 after we pass a second occurrence of the `keymap' symbol. */
304 if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
305 noprefix = 1;
306 break;
307
308 case Lisp_Cons:
309 if (EQ (XCONS (binding)->car, idx))
310 {
311 val = XCONS (binding)->cdr;
312 if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
313 return Qnil;
314 return val;
315 }
316 if (t_ok && EQ (XCONS (binding)->car, Qt))
317 t_binding = XCONS (binding)->cdr;
318 break;
319
320 case Lisp_Vector:
321 if (INTEGERP (idx)
322 && XINT (idx) >= 0
323 && XINT (idx) < XVECTOR (binding)->size)
324 {
325 val = XVECTOR (binding)->contents[XINT (idx)];
326 if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
327 return Qnil;
328 return val;
329 }
330 break;
331 }
332
333 QUIT;
334 }
335
336 return t_binding;
337 }
338 }
339
340 /* Given OBJECT which was found in a slot in a keymap,
341 trace indirect definitions to get the actual definition of that slot.
342 An indirect definition is a list of the form
343 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
344 and INDEX is the object to look up in KEYMAP to yield the definition.
345
346 Also if OBJECT has a menu string as the first element,
347 remove that. Also remove a menu help string as second element.
348
349 If AUTOLOAD is nonzero, load autoloadable keymaps
350 that are referred to with indirection. */
351
352 Lisp_Object
353 get_keyelt (object, autoload)
354 register Lisp_Object object;
355 int autoload;
356 {
357 while (1)
358 {
359 register Lisp_Object map, tem;
360
361 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
362 map = get_keymap_1 (Fcar_safe (object), 0, autoload);
363 tem = Fkeymapp (map);
364 if (!NILP (tem))
365 object = access_keymap (map, Fcdr (object), 0, 0);
366
367 /* If the keymap contents looks like (STRING . DEFN),
368 use DEFN.
369 Keymap alist elements like (CHAR MENUSTRING . DEFN)
370 will be used by HierarKey menus. */
371 else if (CONSP (object)
372 && STRINGP (XCONS (object)->car))
373 {
374 object = XCONS (object)->cdr;
375 /* Also remove a menu help string, if any,
376 following the menu item name. */
377 if (CONSP (object) && STRINGP (XCONS (object)->car))
378 object = XCONS (object)->cdr;
379 /* Also remove the sublist that caches key equivalences, if any. */
380 if (CONSP (object)
381 && CONSP (XCONS (object)->car))
382 {
383 Lisp_Object carcar;
384 carcar = XCONS (XCONS (object)->car)->car;
385 if (NILP (carcar) || VECTORP (carcar))
386 object = XCONS (object)->cdr;
387 }
388 }
389
390 else
391 /* Anything else is really the value. */
392 return object;
393 }
394 }
395
396 Lisp_Object
397 store_in_keymap (keymap, idx, def)
398 Lisp_Object keymap;
399 register Lisp_Object idx;
400 register Lisp_Object def;
401 {
402 if (!CONSP (keymap) || ! EQ (XCONS (keymap)->car, Qkeymap))
403 error ("attempt to define a key in a non-keymap");
404
405 /* If idx is a list (some sort of mouse click, perhaps?),
406 the index we want to use is the car of the list, which
407 ought to be a symbol. */
408 idx = EVENT_HEAD (idx);
409
410 /* If idx is a symbol, it might have modifiers, which need to
411 be put in the canonical order. */
412 if (SYMBOLP (idx))
413 idx = reorder_modifiers (idx);
414 else if (INTEGERP (idx))
415 /* Clobber the high bits that can be present on a machine
416 with more than 24 bits of integer. */
417 XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1));
418
419 /* Scan the keymap for a binding of idx. */
420 {
421 Lisp_Object tail;
422
423 /* The cons after which we should insert new bindings. If the
424 keymap has a table element, we record its position here, so new
425 bindings will go after it; this way, the table will stay
426 towards the front of the alist and character lookups in dense
427 keymaps will remain fast. Otherwise, this just points at the
428 front of the keymap. */
429 Lisp_Object insertion_point;
430
431 insertion_point = keymap;
432 for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = XCONS (tail)->cdr)
433 {
434 Lisp_Object elt;
435
436 elt = XCONS (tail)->car;
437 switch (XTYPE (elt))
438 {
439 case Lisp_Vector:
440 if (INTEGERP (idx)
441 && XINT (idx) >= 0 && XINT (idx) < XVECTOR (elt)->size)
442 {
443 XVECTOR (elt)->contents[XFASTINT (idx)] = def;
444 return def;
445 }
446 insertion_point = tail;
447 break;
448
449 case Lisp_Cons:
450 if (EQ (idx, XCONS (elt)->car))
451 {
452 XCONS (elt)->cdr = def;
453 return def;
454 }
455 break;
456
457 case Lisp_Symbol:
458 /* If we find a 'keymap' symbol in the spine of KEYMAP,
459 then we must have found the start of a second keymap
460 being used as the tail of KEYMAP, and a binding for IDX
461 should be inserted before it. */
462 if (EQ (elt, Qkeymap))
463 goto keymap_end;
464 break;
465 }
466
467 QUIT;
468 }
469
470 keymap_end:
471 /* We have scanned the entire keymap, and not found a binding for
472 IDX. Let's add one. */
473 XCONS (insertion_point)->cdr =
474 Fcons (Fcons (idx, def), XCONS (insertion_point)->cdr);
475 }
476
477 return def;
478 }
479
480
481 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
482 "Return a copy of the keymap KEYMAP.\n\
483 The copy starts out with the same definitions of KEYMAP,\n\
484 but changing either the copy or KEYMAP does not affect the other.\n\
485 Any key definitions that are subkeymaps are recursively copied.\n\
486 However, a key definition which is a symbol whose definition is a keymap\n\
487 is not copied.")
488 (keymap)
489 Lisp_Object keymap;
490 {
491 register Lisp_Object copy, tail;
492
493 copy = Fcopy_alist (get_keymap (keymap));
494
495 for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr)
496 {
497 Lisp_Object elt;
498
499 elt = XCONS (tail)->car;
500 if (VECTORP (elt))
501 {
502 int i;
503
504 elt = Fcopy_sequence (elt);
505 XCONS (tail)->car = elt;
506
507 for (i = 0; i < XVECTOR (elt)->size; i++)
508 if (!SYMBOLP (XVECTOR (elt)->contents[i])
509 && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i])))
510 XVECTOR (elt)->contents[i] =
511 Fcopy_keymap (XVECTOR (elt)->contents[i]);
512 }
513 else if (CONSP (elt))
514 {
515 /* Skip the optional menu string. */
516 if (CONSP (XCONS (elt)->cdr)
517 && STRINGP (XCONS (XCONS (elt)->cdr)->car))
518 {
519 Lisp_Object tem;
520
521 /* Copy the cell, since copy-alist didn't go this deep. */
522 XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
523 XCONS (XCONS (elt)->cdr)->cdr);
524 elt = XCONS (elt)->cdr;
525
526 /* Also skip the optional menu help string. */
527 if (CONSP (XCONS (elt)->cdr)
528 && STRINGP (XCONS (XCONS (elt)->cdr)->car))
529 {
530 XCONS (elt)->cdr = Fcons (XCONS (XCONS (elt)->cdr)->car,
531 XCONS (XCONS (elt)->cdr)->cdr);
532 elt = XCONS (elt)->cdr;
533 }
534 /* There may also be a list that caches key equivalences.
535 Just delete it for the new keymap. */
536 if (CONSP (XCONS (elt)->cdr)
537 && CONSP (XCONS (XCONS (elt)->cdr)->car)
538 && (NILP (tem = XCONS (XCONS (XCONS (elt)->cdr)->car)->car)
539 || VECTORP (tem)))
540 XCONS (elt)->cdr = XCONS (XCONS (elt)->cdr)->cdr;
541 }
542 if (CONSP (elt)
543 && ! SYMBOLP (XCONS (elt)->cdr)
544 && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
545 XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
546 }
547 }
548
549 return copy;
550 }
551 \f
552 /* Simple Keymap mutators and accessors. */
553
554 /* GC is possible in this function if it autoloads a keymap. */
555
556 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
557 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
558 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
559 meaning a sequence of keystrokes and events.\n\
560 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
561 can be included if you use a vector.\n\
562 DEF is anything that can be a key's definition:\n\
563 nil (means key is undefined in this keymap),\n\
564 a command (a Lisp function suitable for interactive calling)\n\
565 a string (treated as a keyboard macro),\n\
566 a keymap (to define a prefix key),\n\
567 a symbol. When the key is looked up, the symbol will stand for its\n\
568 function definition, which should at that time be one of the above,\n\
569 or another symbol whose function definition is used, etc.\n\
570 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
571 (DEFN should be a valid definition in its own right),\n\
572 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
573 \n\
574 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
575 the front of KEYMAP.")
576 (keymap, key, def)
577 Lisp_Object keymap;
578 Lisp_Object key;
579 Lisp_Object def;
580 {
581 register int idx;
582 register Lisp_Object c;
583 register Lisp_Object tem;
584 register Lisp_Object cmd;
585 int metized = 0;
586 int meta_bit;
587 int length;
588 struct gcpro gcpro1, gcpro2, gcpro3;
589
590 keymap = get_keymap_1 (keymap, 1, 1);
591
592 if (!VECTORP (key) && !STRINGP (key))
593 key = wrong_type_argument (Qarrayp, key);
594
595 length = XFASTINT (Flength (key));
596 if (length == 0)
597 return Qnil;
598
599 GCPRO3 (keymap, key, def);
600
601 if (VECTORP (key))
602 meta_bit = meta_modifier;
603 else
604 meta_bit = 0x80;
605
606 idx = 0;
607 while (1)
608 {
609 c = Faref (key, make_number (idx));
610
611 if (INTEGERP (c)
612 && (XINT (c) & meta_bit)
613 && !metized)
614 {
615 c = meta_prefix_char;
616 metized = 1;
617 }
618 else
619 {
620 if (INTEGERP (c))
621 XSETINT (c, XINT (c) & ~meta_bit);
622
623 metized = 0;
624 idx++;
625 }
626
627 if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
628 error ("Key sequence contains invalid events");
629
630 if (idx == length)
631 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
632
633 cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1);
634
635 /* If this key is undefined, make it a prefix. */
636 if (NILP (cmd))
637 cmd = define_as_prefix (keymap, c);
638
639 keymap = get_keymap_1 (cmd, 0, 1);
640 if (NILP (keymap))
641 /* We must use Fkey_description rather than just passing key to
642 error; key might be a vector, not a string. */
643 error ("Key sequence %s uses invalid prefix characters",
644 XSTRING (Fkey_description (key))->data);
645 }
646 }
647
648 /* Value is number if KEY is too long; NIL if valid but has no definition. */
649 /* GC is possible in this function if it autoloads a keymap. */
650
651 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
652 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
653 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
654 \n\
655 A number as value means KEY is \"too long\";\n\
656 that is, characters or symbols in it except for the last one\n\
657 fail to be a valid sequence of prefix characters in KEYMAP.\n\
658 The number is how many characters at the front of KEY\n\
659 it takes to reach a non-prefix command.\n\
660 \n\
661 Normally, `lookup-key' ignores bindings for t, which act as default\n\
662 bindings, used when nothing else in the keymap applies; this makes it\n\
663 useable as a general function for probing keymaps. However, if the\n\
664 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
665 recognize the default bindings, just as `read-key-sequence' does.")
666 (keymap, key, accept_default)
667 register Lisp_Object keymap;
668 Lisp_Object key;
669 Lisp_Object accept_default;
670 {
671 register int idx;
672 register Lisp_Object tem;
673 register Lisp_Object cmd;
674 register Lisp_Object c;
675 int metized = 0;
676 int length;
677 int t_ok = ! NILP (accept_default);
678 int meta_bit;
679 struct gcpro gcpro1;
680
681 keymap = get_keymap_1 (keymap, 1, 1);
682
683 if (!VECTORP (key) && !STRINGP (key))
684 key = wrong_type_argument (Qarrayp, key);
685
686 length = XFASTINT (Flength (key));
687 if (length == 0)
688 return keymap;
689
690 if (VECTORP (key))
691 meta_bit = meta_modifier;
692 else
693 meta_bit = 0x80;
694
695 GCPRO1 (key);
696
697 idx = 0;
698 while (1)
699 {
700 c = Faref (key, make_number (idx));
701
702 if (INTEGERP (c)
703 && (XINT (c) & meta_bit)
704 && !metized)
705 {
706 c = meta_prefix_char;
707 metized = 1;
708 }
709 else
710 {
711 if (INTEGERP (c))
712 XSETINT (c, XINT (c) & ~meta_bit);
713
714 metized = 0;
715 idx++;
716 }
717
718 cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1);
719 if (idx == length)
720 RETURN_UNGCPRO (cmd);
721
722 keymap = get_keymap_1 (cmd, 0, 1);
723 if (NILP (keymap))
724 RETURN_UNGCPRO (make_number (idx));
725
726 QUIT;
727 }
728 }
729
730 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
731 Assume that currently it does not define C at all.
732 Return the keymap. */
733
734 static Lisp_Object
735 define_as_prefix (keymap, c)
736 Lisp_Object keymap, c;
737 {
738 Lisp_Object inherit, cmd;
739
740 cmd = Fmake_sparse_keymap (Qnil);
741 /* If this key is defined as a prefix in an inherited keymap,
742 make it a prefix in this map, and make its definition
743 inherit the other prefix definition. */
744 inherit = access_keymap (keymap, c, 0, 0);
745 if (NILP (inherit))
746 {
747 /* If there's an inherited keymap
748 and it doesn't define this key,
749 make it define this key. */
750 Lisp_Object tail;
751
752 for (tail = Fcdr (keymap); CONSP (tail); tail = XCONS (tail)->cdr)
753 if (EQ (XCONS (tail)->car, Qkeymap))
754 break;
755
756 if (!NILP (tail))
757 inherit = define_as_prefix (tail, c);
758 }
759
760 cmd = nconc2 (cmd, inherit);
761 store_in_keymap (keymap, c, cmd);
762
763 return cmd;
764 }
765
766 /* Append a key to the end of a key sequence. We always make a vector. */
767
768 Lisp_Object
769 append_key (key_sequence, key)
770 Lisp_Object key_sequence, key;
771 {
772 Lisp_Object args[2];
773
774 args[0] = key_sequence;
775
776 args[1] = Fcons (key, Qnil);
777 return Fvconcat (2, args);
778 }
779
780 \f
781 /* Global, local, and minor mode keymap stuff. */
782
783 /* We can't put these variables inside current_minor_maps, since under
784 some systems, static gets macro-defined to be the empty string.
785 Ickypoo. */
786 static Lisp_Object *cmm_modes, *cmm_maps;
787 static int cmm_size;
788
789 /* Store a pointer to an array of the keymaps of the currently active
790 minor modes in *buf, and return the number of maps it contains.
791
792 This function always returns a pointer to the same buffer, and may
793 free or reallocate it, so if you want to keep it for a long time or
794 hand it out to lisp code, copy it. This procedure will be called
795 for every key sequence read, so the nice lispy approach (return a
796 new assoclist, list, what have you) for each invocation would
797 result in a lot of consing over time.
798
799 If we used xrealloc/xmalloc and ran out of memory, they would throw
800 back to the command loop, which would try to read a key sequence,
801 which would call this function again, resulting in an infinite
802 loop. Instead, we'll use realloc/malloc and silently truncate the
803 list, let the key sequence be read, and hope some other piece of
804 code signals the error. */
805 int
806 current_minor_maps (modeptr, mapptr)
807 Lisp_Object **modeptr, **mapptr;
808 {
809 int i = 0;
810 Lisp_Object alist, assoc, var, val;
811
812 for (alist = Vminor_mode_map_alist;
813 CONSP (alist);
814 alist = XCONS (alist)->cdr)
815 if (CONSP (assoc = XCONS (alist)->car)
816 && SYMBOLP (var = XCONS (assoc)->car)
817 && ! EQ ((val = find_symbol_value (var)), Qunbound)
818 && ! NILP (val))
819 {
820 if (i >= cmm_size)
821 {
822 Lisp_Object *newmodes, *newmaps;
823
824 if (cmm_maps)
825 {
826 BLOCK_INPUT;
827 cmm_size *= 2;
828 newmodes
829 = (Lisp_Object *) realloc (cmm_modes,
830 cmm_size * sizeof (Lisp_Object));
831 newmaps
832 = (Lisp_Object *) realloc (cmm_maps,
833 cmm_size * sizeof (Lisp_Object));
834 UNBLOCK_INPUT;
835 }
836 else
837 {
838 BLOCK_INPUT;
839 cmm_size = 30;
840 newmodes
841 = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
842 newmaps
843 = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
844 UNBLOCK_INPUT;
845 }
846
847 if (newmaps && newmodes)
848 {
849 cmm_modes = newmodes;
850 cmm_maps = newmaps;
851 }
852 else
853 break;
854 }
855 cmm_modes[i] = var;
856 cmm_maps [i] = Findirect_function (XCONS (assoc)->cdr);
857 i++;
858 }
859
860 if (modeptr) *modeptr = cmm_modes;
861 if (mapptr) *mapptr = cmm_maps;
862 return i;
863 }
864
865 /* GC is possible in this function if it autoloads a keymap. */
866
867 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
868 "Return the binding for command KEY in current keymaps.\n\
869 KEY is a string or vector, a sequence of keystrokes.\n\
870 The binding is probably a symbol with a function definition.\n\
871 \n\
872 Normally, `key-binding' ignores bindings for t, which act as default\n\
873 bindings, used when nothing else in the keymap applies; this makes it\n\
874 usable as a general function for probing keymaps. However, if the\n\
875 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
876 recognize the default bindings, just as `read-key-sequence' does.")
877 (key, accept_default)
878 Lisp_Object key, accept_default;
879 {
880 Lisp_Object *maps, value;
881 int nmaps, i;
882 struct gcpro gcpro1;
883
884 GCPRO1 (key);
885
886 if (!NILP (Voverriding_local_map))
887 {
888 value = Flookup_key (Voverriding_local_map, key, accept_default);
889 if (! NILP (value) && !INTEGERP (value))
890 RETURN_UNGCPRO (value);
891 }
892 else
893 {
894 nmaps = current_minor_maps (0, &maps);
895 /* Note that all these maps are GCPRO'd
896 in the places where we found them. */
897
898 for (i = 0; i < nmaps; i++)
899 if (! NILP (maps[i]))
900 {
901 value = Flookup_key (maps[i], key, accept_default);
902 if (! NILP (value) && !INTEGERP (value))
903 RETURN_UNGCPRO (value);
904 }
905
906 if (! NILP (current_buffer->keymap))
907 {
908 value = Flookup_key (current_buffer->keymap, key, accept_default);
909 if (! NILP (value) && !INTEGERP (value))
910 RETURN_UNGCPRO (value);
911 }
912 }
913
914 value = Flookup_key (current_global_map, key, accept_default);
915 UNGCPRO;
916 if (! NILP (value) && !INTEGERP (value))
917 return value;
918
919 return Qnil;
920 }
921
922 /* GC is possible in this function if it autoloads a keymap. */
923
924 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
925 "Return the binding for command KEYS in current local keymap only.\n\
926 KEYS is a string, a sequence of keystrokes.\n\
927 The binding is probably a symbol with a function definition.\n\
928 \n\
929 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
930 bindings; see the description of `lookup-key' for more details about this.")
931 (keys, accept_default)
932 Lisp_Object keys, accept_default;
933 {
934 register Lisp_Object map;
935 map = current_buffer->keymap;
936 if (NILP (map))
937 return Qnil;
938 return Flookup_key (map, keys, accept_default);
939 }
940
941 /* GC is possible in this function if it autoloads a keymap. */
942
943 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
944 "Return the binding for command KEYS in current global keymap only.\n\
945 KEYS is a string, a sequence of keystrokes.\n\
946 The binding is probably a symbol with a function definition.\n\
947 This function's return values are the same as those of lookup-key\n\
948 \(which see).\n\
949 \n\
950 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
951 bindings; see the description of `lookup-key' for more details about this.")
952 (keys, accept_default)
953 Lisp_Object keys, accept_default;
954 {
955 return Flookup_key (current_global_map, keys, accept_default);
956 }
957
958 /* GC is possible in this function if it autoloads a keymap. */
959
960 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
961 "Find the visible minor mode bindings of KEY.\n\
962 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
963 the symbol which names the minor mode binding KEY, and BINDING is\n\
964 KEY's definition in that mode. In particular, if KEY has no\n\
965 minor-mode bindings, return nil. If the first binding is a\n\
966 non-prefix, all subsequent bindings will be omitted, since they would\n\
967 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
968 that come after prefix bindings.\n\
969 \n\
970 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
971 bindings; see the description of `lookup-key' for more details about this.")
972 (key, accept_default)
973 Lisp_Object key, accept_default;
974 {
975 Lisp_Object *modes, *maps;
976 int nmaps;
977 Lisp_Object binding;
978 int i, j;
979 struct gcpro gcpro1, gcpro2;
980
981 nmaps = current_minor_maps (&modes, &maps);
982 /* Note that all these maps are GCPRO'd
983 in the places where we found them. */
984
985 binding = Qnil;
986 GCPRO2 (key, binding);
987
988 for (i = j = 0; i < nmaps; i++)
989 if (! NILP (maps[i])
990 && ! NILP (binding = Flookup_key (maps[i], key, accept_default))
991 && !INTEGERP (binding))
992 {
993 if (! NILP (get_keymap (binding)))
994 maps[j++] = Fcons (modes[i], binding);
995 else if (j == 0)
996 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
997 }
998
999 UNGCPRO;
1000 return Flist (j, maps);
1001 }
1002
1003 DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
1004 "kSet key globally: \nCSet key %s to command: ",
1005 "Give KEY a global binding as COMMAND.\n\
1006 COMMAND is a symbol naming an interactively-callable function.\n\
1007 KEY is a key sequence (a string or vector of characters or event types).\n\
1008 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
1009 can be included if you use a vector.\n\
1010 Note that if KEY has a local binding in the current buffer\n\
1011 that local binding will continue to shadow any global binding.")
1012 (keys, function)
1013 Lisp_Object keys, function;
1014 {
1015 if (!VECTORP (keys) && !STRINGP (keys))
1016 keys = wrong_type_argument (Qarrayp, keys);
1017
1018 Fdefine_key (current_global_map, keys, function);
1019 return Qnil;
1020 }
1021
1022 DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2,
1023 "kSet key locally: \nCSet key %s locally to command: ",
1024 "Give KEY a local binding as COMMAND.\n\
1025 COMMAND is a symbol naming an interactively-callable function.\n\
1026 KEY is a key sequence (a string or vector of characters or event types).\n\
1027 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
1028 can be included if you use a vector.\n\
1029 The binding goes in the current buffer's local map,\n\
1030 which in most cases is shared with all other buffers in the same major mode.")
1031 (keys, function)
1032 Lisp_Object keys, function;
1033 {
1034 register Lisp_Object map;
1035 map = current_buffer->keymap;
1036 if (NILP (map))
1037 {
1038 map = Fmake_sparse_keymap (Qnil);
1039 current_buffer->keymap = map;
1040 }
1041
1042 if (!VECTORP (keys) && !STRINGP (keys))
1043 keys = wrong_type_argument (Qarrayp, keys);
1044
1045 Fdefine_key (map, keys, function);
1046 return Qnil;
1047 }
1048
1049 DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key,
1050 1, 1, "kUnset key globally: ",
1051 "Remove global binding of KEY.\n\
1052 KEY is a string representing a sequence of keystrokes.")
1053 (keys)
1054 Lisp_Object keys;
1055 {
1056 return Fglobal_set_key (keys, Qnil);
1057 }
1058
1059 DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1,
1060 "kUnset key locally: ",
1061 "Remove local binding of KEY.\n\
1062 KEY is a string representing a sequence of keystrokes.")
1063 (keys)
1064 Lisp_Object keys;
1065 {
1066 if (!NILP (current_buffer->keymap))
1067 Flocal_set_key (keys, Qnil);
1068 return Qnil;
1069 }
1070
1071 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0,
1072 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
1073 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1074 If a second optional argument MAPVAR is given, the map is stored as\n\
1075 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1076 as a function.")
1077 (name, mapvar)
1078 Lisp_Object name, mapvar;
1079 {
1080 Lisp_Object map;
1081 map = Fmake_sparse_keymap (Qnil);
1082 Ffset (name, map);
1083 if (!NILP (mapvar))
1084 Fset (mapvar, map);
1085 else
1086 Fset (name, map);
1087 return name;
1088 }
1089
1090 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1091 "Select KEYMAP as the global keymap.")
1092 (keymap)
1093 Lisp_Object keymap;
1094 {
1095 keymap = get_keymap (keymap);
1096 current_global_map = keymap;
1097 record_asynch_buffer_change ();
1098
1099 return Qnil;
1100 }
1101
1102 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1103 "Select KEYMAP as the local keymap.\n\
1104 If KEYMAP is nil, that means no local keymap.")
1105 (keymap)
1106 Lisp_Object keymap;
1107 {
1108 if (!NILP (keymap))
1109 keymap = get_keymap (keymap);
1110
1111 current_buffer->keymap = keymap;
1112 record_asynch_buffer_change ();
1113
1114 return Qnil;
1115 }
1116
1117 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1118 "Return current buffer's local keymap, or nil if it has none.")
1119 ()
1120 {
1121 return current_buffer->keymap;
1122 }
1123
1124 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1125 "Return the current global keymap.")
1126 ()
1127 {
1128 return current_global_map;
1129 }
1130
1131 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1132 "Return a list of keymaps for the minor modes of the current buffer.")
1133 ()
1134 {
1135 Lisp_Object *maps;
1136 int nmaps = current_minor_maps (0, &maps);
1137
1138 return Flist (nmaps, maps);
1139 }
1140 \f
1141 /* Help functions for describing and documenting keymaps. */
1142
1143 /* This function cannot GC. */
1144
1145 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1146 1, 2, 0,
1147 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1148 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1149 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1150 so that the KEYS increase in length. The first element is (\"\" . KEYMAP).\n\
1151 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1152 then the value includes only maps for prefixes that start with PREFIX.")
1153 (startmap, prefix)
1154 Lisp_Object startmap, prefix;
1155 {
1156 Lisp_Object maps, good_maps, tail;
1157 int prefixlen = 0;
1158
1159 /* no need for gcpro because we don't autoload any keymaps. */
1160
1161 if (!NILP (prefix))
1162 prefixlen = XINT (Flength (prefix));
1163
1164 if (!NILP (prefix))
1165 {
1166 /* If a prefix was specified, start with the keymap (if any) for
1167 that prefix, so we don't waste time considering other prefixes. */
1168 Lisp_Object tem;
1169 tem = Flookup_key (startmap, prefix, Qt);
1170 /* Flookup_key may give us nil, or a number,
1171 if the prefix is not defined in this particular map.
1172 It might even give us a list that isn't a keymap. */
1173 tem = get_keymap_1 (tem, 0, 0);
1174 if (!NILP (tem))
1175 maps = Fcons (Fcons (prefix, tem), Qnil);
1176 else
1177 return Qnil;
1178 }
1179 else
1180 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1181 get_keymap (startmap)),
1182 Qnil);
1183
1184 /* For each map in the list maps,
1185 look at any other maps it points to,
1186 and stick them at the end if they are not already in the list.
1187
1188 This is a breadth-first traversal, where tail is the queue of
1189 nodes, and maps accumulates a list of all nodes visited. */
1190
1191 for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr)
1192 {
1193 register Lisp_Object thisseq, thismap;
1194 Lisp_Object last;
1195 /* Does the current sequence end in the meta-prefix-char? */
1196 int is_metized;
1197
1198 thisseq = Fcar (Fcar (tail));
1199 thismap = Fcdr (Fcar (tail));
1200 last = make_number (XINT (Flength (thisseq)) - 1);
1201 is_metized = (XINT (last) >= 0
1202 && EQ (Faref (thisseq, last), meta_prefix_char));
1203
1204 for (; CONSP (thismap); thismap = XCONS (thismap)->cdr)
1205 {
1206 Lisp_Object elt;
1207
1208 elt = XCONS (thismap)->car;
1209
1210 QUIT;
1211
1212 if (VECTORP (elt))
1213 {
1214 register int i;
1215
1216 /* Vector keymap. Scan all the elements. */
1217 for (i = 0; i < XVECTOR (elt)->size; i++)
1218 {
1219 register Lisp_Object tem;
1220 register Lisp_Object cmd;
1221
1222 cmd = get_keyelt (XVECTOR (elt)->contents[i], 0);
1223 if (NILP (cmd)) continue;
1224 tem = Fkeymapp (cmd);
1225 if (!NILP (tem))
1226 {
1227 cmd = get_keymap (cmd);
1228 /* Ignore keymaps that are already added to maps. */
1229 tem = Frassq (cmd, maps);
1230 if (NILP (tem))
1231 {
1232 /* If the last key in thisseq is meta-prefix-char,
1233 turn it into a meta-ized keystroke. We know
1234 that the event we're about to append is an
1235 ascii keystroke since we're processing a
1236 keymap table. */
1237 if (is_metized)
1238 {
1239 int meta_bit = meta_modifier;
1240 tem = Fcopy_sequence (thisseq);
1241
1242 Faset (tem, last, make_number (i | meta_bit));
1243
1244 /* This new sequence is the same length as
1245 thisseq, so stick it in the list right
1246 after this one. */
1247 XCONS (tail)->cdr
1248 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
1249 }
1250 else
1251 {
1252 tem = append_key (thisseq, make_number (i));
1253 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1254 }
1255 }
1256 }
1257 }
1258 }
1259 else if (CONSP (elt))
1260 {
1261 register Lisp_Object cmd, tem, filter;
1262
1263 cmd = get_keyelt (XCONS (elt)->cdr, 0);
1264 /* Ignore definitions that aren't keymaps themselves. */
1265 tem = Fkeymapp (cmd);
1266 if (!NILP (tem))
1267 {
1268 /* Ignore keymaps that have been seen already. */
1269 cmd = get_keymap (cmd);
1270 tem = Frassq (cmd, maps);
1271 if (NILP (tem))
1272 {
1273 /* Let elt be the event defined by this map entry. */
1274 elt = XCONS (elt)->car;
1275
1276 /* If the last key in thisseq is meta-prefix-char, and
1277 this entry is a binding for an ascii keystroke,
1278 turn it into a meta-ized keystroke. */
1279 if (is_metized && INTEGERP (elt))
1280 {
1281 tem = Fcopy_sequence (thisseq);
1282 Faset (tem, last,
1283 make_number (XINT (elt) | meta_modifier));
1284
1285 /* This new sequence is the same length as
1286 thisseq, so stick it in the list right
1287 after this one. */
1288 XCONS (tail)->cdr
1289 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
1290 }
1291 else
1292 nconc2 (tail,
1293 Fcons (Fcons (append_key (thisseq, elt), cmd),
1294 Qnil));
1295 }
1296 }
1297 }
1298 }
1299 }
1300
1301 if (NILP (prefix))
1302 return maps;
1303
1304 /* Now find just the maps whose access prefixes start with PREFIX. */
1305
1306 good_maps = Qnil;
1307 for (; CONSP (maps); maps = XCONS (maps)->cdr)
1308 {
1309 Lisp_Object elt, thisseq;
1310 elt = XCONS (maps)->car;
1311 thisseq = XCONS (elt)->car;
1312 /* The access prefix must be at least as long as PREFIX,
1313 and the first elements must match those of PREFIX. */
1314 if (XINT (Flength (thisseq)) >= prefixlen)
1315 {
1316 int i;
1317 for (i = 0; i < prefixlen; i++)
1318 {
1319 Lisp_Object i1;
1320 XFASTINT (i1) = i;
1321 if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1322 break;
1323 }
1324 if (i == prefixlen)
1325 good_maps = Fcons (elt, good_maps);
1326 }
1327 }
1328
1329 return Fnreverse (good_maps);
1330 }
1331
1332 Lisp_Object Qsingle_key_description, Qkey_description;
1333
1334 /* This function cannot GC. */
1335
1336 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1337 "Return a pretty description of key-sequence KEYS.\n\
1338 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1339 spaces are put between sequence elements, etc.")
1340 (keys)
1341 Lisp_Object keys;
1342 {
1343 int len;
1344 int i;
1345 Lisp_Object sep;
1346 Lisp_Object *args;
1347
1348 if (STRINGP (keys))
1349 {
1350 Lisp_Object vector;
1351 vector = Fmake_vector (Flength (keys), Qnil);
1352 for (i = 0; i < XSTRING (keys)->size; i++)
1353 {
1354 if (XSTRING (keys)->data[i] & 0x80)
1355 XFASTINT (XVECTOR (vector)->contents[i])
1356 = meta_modifier | (XSTRING (keys)->data[i] & ~0x80);
1357 else
1358 XFASTINT (XVECTOR (vector)->contents[i])
1359 = XSTRING (keys)->data[i];
1360 }
1361 keys = vector;
1362 }
1363 else if (!VECTORP (keys))
1364 keys = wrong_type_argument (Qarrayp, keys);
1365
1366 /* In effect, this computes
1367 (mapconcat 'single-key-description keys " ")
1368 but we shouldn't use mapconcat because it can do GC. */
1369
1370 len = XVECTOR (keys)->size;
1371 sep = build_string (" ");
1372 /* This has one extra element at the end that we don't pass to Fconcat. */
1373 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1374
1375 for (i = 0; i < len; i++)
1376 {
1377 args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
1378 args[i * 2 + 1] = sep;
1379 }
1380
1381 return Fconcat (len * 2 - 1, args);
1382 }
1383
1384 char *
1385 push_key_description (c, p)
1386 register unsigned int c;
1387 register char *p;
1388 {
1389 /* Clear all the meaningless bits above the meta bit. */
1390 c &= meta_modifier | ~ - meta_modifier;
1391
1392 if (c & alt_modifier)
1393 {
1394 *p++ = 'A';
1395 *p++ = '-';
1396 c -= alt_modifier;
1397 }
1398 if (c & ctrl_modifier)
1399 {
1400 *p++ = 'C';
1401 *p++ = '-';
1402 c -= ctrl_modifier;
1403 }
1404 if (c & hyper_modifier)
1405 {
1406 *p++ = 'H';
1407 *p++ = '-';
1408 c -= hyper_modifier;
1409 }
1410 if (c & meta_modifier)
1411 {
1412 *p++ = 'M';
1413 *p++ = '-';
1414 c -= meta_modifier;
1415 }
1416 if (c & shift_modifier)
1417 {
1418 *p++ = 'S';
1419 *p++ = '-';
1420 c -= shift_modifier;
1421 }
1422 if (c & super_modifier)
1423 {
1424 *p++ = 's';
1425 *p++ = '-';
1426 c -= super_modifier;
1427 }
1428 if (c < 040)
1429 {
1430 if (c == 033)
1431 {
1432 *p++ = 'E';
1433 *p++ = 'S';
1434 *p++ = 'C';
1435 }
1436 else if (c == '\t')
1437 {
1438 *p++ = 'T';
1439 *p++ = 'A';
1440 *p++ = 'B';
1441 }
1442 else if (c == Ctl('J'))
1443 {
1444 *p++ = 'L';
1445 *p++ = 'F';
1446 *p++ = 'D';
1447 }
1448 else if (c == Ctl('M'))
1449 {
1450 *p++ = 'R';
1451 *p++ = 'E';
1452 *p++ = 'T';
1453 }
1454 else
1455 {
1456 *p++ = 'C';
1457 *p++ = '-';
1458 if (c > 0 && c <= Ctl ('Z'))
1459 *p++ = c + 0140;
1460 else
1461 *p++ = c + 0100;
1462 }
1463 }
1464 else if (c == 0177)
1465 {
1466 *p++ = 'D';
1467 *p++ = 'E';
1468 *p++ = 'L';
1469 }
1470 else if (c == ' ')
1471 {
1472 *p++ = 'S';
1473 *p++ = 'P';
1474 *p++ = 'C';
1475 }
1476 else if (c < 256)
1477 *p++ = c;
1478 else
1479 {
1480 *p++ = '\\';
1481 *p++ = (7 & (c >> 15)) + '0';
1482 *p++ = (7 & (c >> 12)) + '0';
1483 *p++ = (7 & (c >> 9)) + '0';
1484 *p++ = (7 & (c >> 6)) + '0';
1485 *p++ = (7 & (c >> 3)) + '0';
1486 *p++ = (7 & (c >> 0)) + '0';
1487 }
1488
1489 return p;
1490 }
1491
1492 /* This function cannot GC. */
1493
1494 DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
1495 "Return a pretty description of command character KEY.\n\
1496 Control characters turn into C-whatever, etc.")
1497 (key)
1498 Lisp_Object key;
1499 {
1500 char tem[20];
1501
1502 key = EVENT_HEAD (key);
1503
1504 switch (XTYPE (key))
1505 {
1506 case Lisp_Int: /* Normal character */
1507 *push_key_description (XUINT (key), tem) = 0;
1508 return build_string (tem);
1509
1510 case Lisp_Symbol: /* Function key or event-symbol */
1511 return Fsymbol_name (key);
1512
1513 /* Buffer names in the menubar can trigger this. */
1514 case Lisp_String:
1515 return Fcopy_sequence (key);
1516
1517 default:
1518 error ("KEY must be an integer, cons, symbol, or string");
1519 }
1520 }
1521
1522 char *
1523 push_text_char_description (c, p)
1524 register unsigned int c;
1525 register char *p;
1526 {
1527 if (c >= 0200)
1528 {
1529 *p++ = 'M';
1530 *p++ = '-';
1531 c -= 0200;
1532 }
1533 if (c < 040)
1534 {
1535 *p++ = '^';
1536 *p++ = c + 64; /* 'A' - 1 */
1537 }
1538 else if (c == 0177)
1539 {
1540 *p++ = '^';
1541 *p++ = '?';
1542 }
1543 else
1544 *p++ = c;
1545 return p;
1546 }
1547
1548 /* This function cannot GC. */
1549
1550 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1551 "Return a pretty description of file-character CHAR.\n\
1552 Control characters turn into \"^char\", etc.")
1553 (chr)
1554 Lisp_Object chr;
1555 {
1556 char tem[6];
1557
1558 CHECK_NUMBER (chr, 0);
1559
1560 *push_text_char_description (XINT (chr) & 0377, tem) = 0;
1561
1562 return build_string (tem);
1563 }
1564
1565 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
1566 a meta bit. */
1567 static int
1568 ascii_sequence_p (seq)
1569 Lisp_Object seq;
1570 {
1571 Lisp_Object i;
1572 int len = XINT (Flength (seq));
1573
1574 for (XFASTINT (i) = 0; XFASTINT (i) < len; XFASTINT (i)++)
1575 {
1576 Lisp_Object elt;
1577
1578 elt = Faref (seq, i);
1579
1580 if (!INTEGERP (elt)
1581 || (XUINT (elt) & ~CHAR_META) >= 0x80)
1582 return 0;
1583 }
1584
1585 return 1;
1586 }
1587
1588 \f
1589 /* where-is - finding a command in a set of keymaps. */
1590
1591 /* This function can GC if Flookup_key autoloads any keymaps. */
1592
1593 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
1594 "Return list of keys that invoke DEFINITION.\n\
1595 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
1596 If KEYMAP is nil, search all the currently active keymaps.\n\
1597 \n\
1598 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
1599 rather than a list of all possible key sequences.\n\
1600 If FIRSTONLY is t, avoid key sequences which use non-ASCII\n\
1601 keys and therefore may not be usable on ASCII terminals. If FIRSTONLY\n\
1602 is the symbol `non-ascii', return the first binding found, no matter\n\
1603 what its components.\n\
1604 \n\
1605 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
1606 to other keymaps or slots. This makes it possible to search for an\n\
1607 indirect definition itself.")
1608 (definition, keymap, firstonly, noindirect)
1609 Lisp_Object definition, keymap;
1610 Lisp_Object firstonly, noindirect;
1611 {
1612 Lisp_Object maps;
1613 Lisp_Object found, sequence;
1614 int keymap_specified = !NILP (keymap);
1615 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1616
1617 if (! keymap_specified)
1618 {
1619 #ifdef USE_TEXT_PROPERTIES
1620 keymap = get_local_map (PT, current_buffer);
1621 #else
1622 keymap = current_buffer->keymap;
1623 #endif
1624 }
1625
1626 if (!NILP (keymap))
1627 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil),
1628 Faccessible_keymaps (get_keymap (current_global_map),
1629 Qnil));
1630 else
1631 maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
1632
1633 /* Put the minor mode keymaps on the front. */
1634 if (! keymap_specified)
1635 {
1636 Lisp_Object minors;
1637 minors = Fnreverse (Fcurrent_minor_mode_maps ());
1638 while (!NILP (minors))
1639 {
1640 maps = nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors)->car),
1641 Qnil),
1642 maps);
1643 minors = XCONS (minors)->cdr;
1644 }
1645 }
1646
1647 GCPRO5 (definition, keymap, maps, found, sequence);
1648 found = Qnil;
1649 sequence = Qnil;
1650
1651 for (; !NILP (maps); maps = Fcdr (maps))
1652 {
1653 /* Key sequence to reach map, and the map that it reaches */
1654 register Lisp_Object this, map;
1655
1656 /* If Fcar (map) is a VECTOR, the current element within that vector. */
1657 int i = 0;
1658
1659 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1660 [M-CHAR] sequences, check if last character of the sequence
1661 is the meta-prefix char. */
1662 Lisp_Object last;
1663 int last_is_meta;
1664
1665 this = Fcar (Fcar (maps));
1666 map = Fcdr (Fcar (maps));
1667 last = make_number (XINT (Flength (this)) - 1);
1668 last_is_meta = (XINT (last) >= 0
1669 && EQ (Faref (this, last), meta_prefix_char));
1670
1671 QUIT;
1672
1673 while (CONSP (map))
1674 {
1675 /* Because the code we want to run on each binding is rather
1676 large, we don't want to have two separate loop bodies for
1677 sparse keymap bindings and tables; we want to iterate one
1678 loop body over both keymap and vector bindings.
1679
1680 For this reason, if Fcar (map) is a vector, we don't
1681 advance map to the next element until i indicates that we
1682 have finished off the vector. */
1683
1684 Lisp_Object elt, key, binding;
1685 elt = XCONS (map)->car;
1686
1687 QUIT;
1688
1689 /* Set key and binding to the current key and binding, and
1690 advance map and i to the next binding. */
1691 if (VECTORP (elt))
1692 {
1693 /* In a vector, look at each element. */
1694 binding = XVECTOR (elt)->contents[i];
1695 XFASTINT (key) = i;
1696 i++;
1697
1698 /* If we've just finished scanning a vector, advance map
1699 to the next element, and reset i in anticipation of the
1700 next vector we may find. */
1701 if (i >= XVECTOR (elt)->size)
1702 {
1703 map = XCONS (map)->cdr;
1704 i = 0;
1705 }
1706 }
1707 else if (CONSP (elt))
1708 {
1709 key = Fcar (Fcar (map));
1710 binding = Fcdr (Fcar (map));
1711
1712 map = XCONS (map)->cdr;
1713 }
1714 else
1715 /* We want to ignore keymap elements that are neither
1716 vectors nor conses. */
1717 {
1718 map = XCONS (map)->cdr;
1719 continue;
1720 }
1721
1722 /* Search through indirections unless that's not wanted. */
1723 if (NILP (noindirect))
1724 binding = get_keyelt (binding, 0);
1725
1726 /* End this iteration if this element does not match
1727 the target. */
1728
1729 if (CONSP (definition))
1730 {
1731 Lisp_Object tem;
1732 tem = Fequal (binding, definition);
1733 if (NILP (tem))
1734 continue;
1735 }
1736 else
1737 if (!EQ (binding, definition))
1738 continue;
1739
1740 /* We have found a match.
1741 Construct the key sequence where we found it. */
1742 if (INTEGERP (key) && last_is_meta)
1743 {
1744 sequence = Fcopy_sequence (this);
1745 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
1746 }
1747 else
1748 sequence = append_key (this, key);
1749
1750 /* Verify that this key binding is not shadowed by another
1751 binding for the same key, before we say it exists.
1752
1753 Mechanism: look for local definition of this key and if
1754 it is defined and does not match what we found then
1755 ignore this key.
1756
1757 Either nil or number as value from Flookup_key
1758 means undefined. */
1759 if (keymap_specified)
1760 {
1761 binding = Flookup_key (keymap, sequence, Qnil);
1762 if (!NILP (binding) && !INTEGERP (binding))
1763 {
1764 if (CONSP (definition))
1765 {
1766 Lisp_Object tem;
1767 tem = Fequal (binding, definition);
1768 if (NILP (tem))
1769 continue;
1770 }
1771 else
1772 if (!EQ (binding, definition))
1773 continue;
1774 }
1775 }
1776 else
1777 {
1778 binding = Fkey_binding (sequence, Qnil);
1779 if (!EQ (binding, definition))
1780 continue;
1781 }
1782
1783 /* It is a true unshadowed match. Record it, unless it's already
1784 been seen (as could happen when inheriting keymaps). */
1785 if (NILP (Fmember (sequence, found)))
1786 found = Fcons (sequence, found);
1787
1788 /* If firstonly is Qnon_ascii, then we can return the first
1789 binding we find. If firstonly is not Qnon_ascii but not
1790 nil, then we should return the first ascii-only binding
1791 we find. */
1792 if (EQ (firstonly, Qnon_ascii))
1793 RETURN_UNGCPRO (sequence);
1794 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
1795 RETURN_UNGCPRO (sequence);
1796 }
1797 }
1798
1799 UNGCPRO;
1800
1801 found = Fnreverse (found);
1802
1803 /* firstonly may have been t, but we may have gone all the way through
1804 the keymaps without finding an all-ASCII key sequence. So just
1805 return the best we could find. */
1806 if (! NILP (firstonly))
1807 return Fcar (found);
1808
1809 return found;
1810 }
1811 \f
1812 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
1813
1814 DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
1815 "Show a list of all defined keys, and their definitions.\n\
1816 The list is put in a buffer, which is displayed.\n\
1817 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1818 then we display only bindings that start with that prefix.")
1819 (prefix)
1820 Lisp_Object prefix;
1821 {
1822 register Lisp_Object thisbuf;
1823 XSET (thisbuf, Lisp_Buffer, current_buffer);
1824 internal_with_output_to_temp_buffer ("*Help*",
1825 describe_buffer_bindings,
1826 Fcons (thisbuf, prefix));
1827 return Qnil;
1828 }
1829
1830 /* ARG is (BUFFER . PREFIX). */
1831
1832 static Lisp_Object
1833 describe_buffer_bindings (arg)
1834 Lisp_Object arg;
1835 {
1836 Lisp_Object descbuf, prefix, shadow;
1837 register Lisp_Object start1;
1838 struct gcpro gcpro1;
1839
1840 char *alternate_heading
1841 = "\
1842 Alternate Characters (use anywhere the nominal character is listed):\n\
1843 nominal alternate\n\
1844 ------- ---------\n";
1845
1846 descbuf = XCONS (arg)->car;
1847 prefix = XCONS (arg)->cdr;
1848 shadow = Qnil;
1849 GCPRO1 (shadow);
1850
1851 Fset_buffer (Vstandard_output);
1852
1853 /* Report on alternates for keys. */
1854 if (STRINGP (Vkeyboard_translate_table))
1855 {
1856 int c;
1857 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
1858 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
1859
1860 for (c = 0; c < translate_len; c++)
1861 if (translate[c] != c)
1862 {
1863 char buf[20];
1864 char *bufend;
1865
1866 if (alternate_heading)
1867 {
1868 insert_string (alternate_heading);
1869 alternate_heading = 0;
1870 }
1871
1872 bufend = push_key_description (translate[c], buf);
1873 insert (buf, bufend - buf);
1874 Findent_to (make_number (16), make_number (1));
1875 bufend = push_key_description (c, buf);
1876 insert (buf, bufend - buf);
1877
1878 insert ("\n", 1);
1879 }
1880
1881 insert ("\n", 1);
1882 }
1883
1884 {
1885 int i, nmaps;
1886 Lisp_Object *modes, *maps;
1887
1888 /* Temporarily switch to descbuf, so that we can get that buffer's
1889 minor modes correctly. */
1890 Fset_buffer (descbuf);
1891 if (!NILP (Voverriding_local_map))
1892 nmaps = 0;
1893 else
1894 nmaps = current_minor_maps (&modes, &maps);
1895 Fset_buffer (Vstandard_output);
1896
1897 /* Print the minor mode maps. */
1898 for (i = 0; i < nmaps; i++)
1899 {
1900 /* The title for a minor mode keymap
1901 is constructed at run time.
1902 We let describe_map_tree do the actual insertion
1903 because it takes care of other features when doing so. */
1904 char *title, *p;
1905
1906 if (!SYMBOLP (modes[i]))
1907 abort();
1908
1909 p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
1910 *p++ = '`';
1911 bcopy (XSYMBOL (modes[i])->name->data, p,
1912 XSYMBOL (modes[i])->name->size);
1913 p += XSYMBOL (modes[i])->name->size;
1914 *p++ = '\'';
1915 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
1916 p += sizeof (" Minor Mode Bindings") - 1;
1917 *p = 0;
1918
1919 describe_map_tree (maps[i], 0, shadow, prefix, title, 0);
1920 shadow = Fcons (maps[i], shadow);
1921 }
1922 }
1923
1924 /* Print the (major mode) local map. */
1925 if (!NILP (Voverriding_local_map))
1926 start1 = Voverriding_local_map;
1927 else
1928 start1 = XBUFFER (descbuf)->keymap;
1929
1930 if (!NILP (start1))
1931 {
1932 describe_map_tree (start1, 0, shadow, prefix,
1933 "Major Mode Bindings", 0);
1934 shadow = Fcons (start1, shadow);
1935 }
1936
1937 describe_map_tree (current_global_map, 0, shadow, prefix,
1938 "Global Bindings", 0);
1939
1940 Fset_buffer (descbuf);
1941 UNGCPRO;
1942 return Qnil;
1943 }
1944
1945 /* Insert a desription of the key bindings in STARTMAP,
1946 followed by those of all maps reachable through STARTMAP.
1947 If PARTIAL is nonzero, omit certain "uninteresting" commands
1948 (such as `undefined').
1949 If SHADOW is non-nil, it is a list of maps;
1950 don't mention keys which would be shadowed by any of them.
1951 PREFIX, if non-nil, says mention only keys that start with PREFIX.
1952 TITLE, if not 0, is a string to insert at the beginning.
1953 TITLE should not end with a colon or a newline; we supply that.
1954 If NOMENU is not 0, then omit menu-bar commands. */
1955
1956 void
1957 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu)
1958 Lisp_Object startmap, shadow, prefix;
1959 int partial;
1960 char *title;
1961 int nomenu;
1962 {
1963 Lisp_Object maps, seen, sub_shadows;
1964 struct gcpro gcpro1, gcpro2, gcpro3;
1965 int something = 0;
1966 char *key_heading
1967 = "\
1968 key binding\n\
1969 --- -------\n";
1970
1971 maps = Faccessible_keymaps (startmap, prefix);
1972 seen = Qnil;
1973 sub_shadows = Qnil;
1974 GCPRO3 (maps, seen, sub_shadows);
1975
1976 if (nomenu)
1977 {
1978 Lisp_Object list;
1979
1980 /* Delete from MAPS each element that is for the menu bar. */
1981 for (list = maps; !NILP (list); list = XCONS (list)->cdr)
1982 {
1983 Lisp_Object elt, prefix, tem;
1984
1985 elt = Fcar (list);
1986 prefix = Fcar (elt);
1987 if (XVECTOR (prefix)->size >= 1)
1988 {
1989 tem = Faref (prefix, make_number (0));
1990 if (EQ (tem, Qmenu_bar))
1991 maps = Fdelq (elt, maps);
1992 }
1993 }
1994 }
1995
1996 if (!NILP (maps))
1997 {
1998 if (title)
1999 {
2000 insert_string (title);
2001 if (!NILP (prefix))
2002 {
2003 insert_string (" Starting With ");
2004 insert1 (Fkey_description (prefix));
2005 }
2006 insert_string (":\n");
2007 }
2008 insert_string (key_heading);
2009 something = 1;
2010 }
2011
2012 for (; !NILP (maps); maps = Fcdr (maps))
2013 {
2014 register Lisp_Object elt, prefix, tail;
2015
2016 elt = Fcar (maps);
2017 prefix = Fcar (elt);
2018
2019 sub_shadows = Qnil;
2020
2021 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2022 {
2023 Lisp_Object shmap;
2024
2025 shmap = XCONS (tail)->car;
2026
2027 /* If the sequence by which we reach this keymap is zero-length,
2028 then the shadow map for this keymap is just SHADOW. */
2029 if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
2030 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
2031 ;
2032 /* If the sequence by which we reach this keymap actually has
2033 some elements, then the sequence's definition in SHADOW is
2034 what we should use. */
2035 else
2036 {
2037 shmap = Flookup_key (shmap, Fcar (elt), Qt);
2038 if (INTEGERP (shmap))
2039 shmap = Qnil;
2040 }
2041
2042 /* If shmap is not nil and not a keymap,
2043 it completely shadows this map, so don't
2044 describe this map at all. */
2045 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
2046 goto skip;
2047
2048 if (!NILP (shmap))
2049 sub_shadows = Fcons (shmap, sub_shadows);
2050 }
2051
2052 describe_map (Fcdr (elt), Fcar (elt), describe_command,
2053 partial, sub_shadows, &seen);
2054
2055 skip: ;
2056 }
2057
2058 if (something)
2059 insert_string ("\n");
2060
2061 UNGCPRO;
2062 }
2063
2064 static void
2065 describe_command (definition)
2066 Lisp_Object definition;
2067 {
2068 register Lisp_Object tem1;
2069
2070 Findent_to (make_number (16), make_number (1));
2071
2072 if (SYMBOLP (definition))
2073 {
2074 XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
2075 insert1 (tem1);
2076 insert_string ("\n");
2077 }
2078 else if (STRINGP (definition))
2079 insert_string ("Keyboard Macro\n");
2080 else
2081 {
2082 tem1 = Fkeymapp (definition);
2083 if (!NILP (tem1))
2084 insert_string ("Prefix Command\n");
2085 else
2086 insert_string ("??\n");
2087 }
2088 }
2089
2090 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2091 Returns the first non-nil binding found in any of those maps. */
2092
2093 static Lisp_Object
2094 shadow_lookup (shadow, key, flag)
2095 Lisp_Object shadow, key, flag;
2096 {
2097 Lisp_Object tail, value;
2098
2099 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2100 {
2101 value = Flookup_key (XCONS (tail)->car, key, flag);
2102 if (!NILP (value))
2103 return value;
2104 }
2105 return Qnil;
2106 }
2107
2108 /* Describe the contents of map MAP, assuming that this map itself is
2109 reached by the sequence of prefix keys KEYS (a string or vector).
2110 PARTIAL, SHADOW are as in `describe_map_tree' above. */
2111
2112 static void
2113 describe_map (map, keys, elt_describer, partial, shadow, seen)
2114 register Lisp_Object map;
2115 Lisp_Object keys;
2116 int (*elt_describer) ();
2117 int partial;
2118 Lisp_Object shadow;
2119 Lisp_Object *seen;
2120 {
2121 Lisp_Object elt_prefix;
2122 Lisp_Object tail, definition, event;
2123 Lisp_Object tem;
2124 Lisp_Object suppress;
2125 Lisp_Object kludge;
2126 int first = 1;
2127 struct gcpro gcpro1, gcpro2, gcpro3;
2128
2129 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2130 {
2131 /* Call Fkey_description first, to avoid GC bug for the other string. */
2132 tem = Fkey_description (keys);
2133 elt_prefix = concat2 (tem, build_string (" "));
2134 }
2135 else
2136 elt_prefix = Qnil;
2137
2138 if (partial)
2139 suppress = intern ("suppress-keymap");
2140
2141 /* This vector gets used to present single keys to Flookup_key. Since
2142 that is done once per keymap element, we don't want to cons up a
2143 fresh vector every time. */
2144 kludge = Fmake_vector (make_number (1), Qnil);
2145 definition = Qnil;
2146
2147 GCPRO3 (elt_prefix, definition, kludge);
2148
2149 for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr)
2150 {
2151 QUIT;
2152
2153 if (VECTORP (XCONS (tail)->car))
2154 describe_vector (XCONS (tail)->car,
2155 elt_prefix, elt_describer, partial, shadow);
2156 else if (CONSP (XCONS (tail)->car))
2157 {
2158 event = XCONS (XCONS (tail)->car)->car;
2159
2160 /* Ignore bindings whose "keys" are not really valid events.
2161 (We get these in the frames and buffers menu.) */
2162 if (! (SYMBOLP (event) || INTEGERP (event)))
2163 continue;
2164
2165 definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0);
2166
2167 /* Don't show undefined commands or suppressed commands. */
2168 if (NILP (definition)) continue;
2169 if (SYMBOLP (definition) && partial)
2170 {
2171 tem = Fget (definition, suppress);
2172 if (!NILP (tem))
2173 continue;
2174 }
2175
2176 /* Don't show a command that isn't really visible
2177 because a local definition of the same key shadows it. */
2178
2179 XVECTOR (kludge)->contents[0] = event;
2180 if (!NILP (shadow))
2181 {
2182 tem = shadow_lookup (shadow, kludge, Qt);
2183 if (!NILP (tem)) continue;
2184 }
2185
2186 tem = Flookup_key (map, kludge, Qt);
2187 if (! EQ (tem, definition)) continue;
2188
2189 if (first)
2190 {
2191 insert ("\n", 1);
2192 first = 0;
2193 }
2194
2195 if (!NILP (elt_prefix))
2196 insert1 (elt_prefix);
2197
2198 /* THIS gets the string to describe the character EVENT. */
2199 insert1 (Fsingle_key_description (event));
2200
2201 /* Print a description of the definition of this character.
2202 elt_describer will take care of spacing out far enough
2203 for alignment purposes. */
2204 (*elt_describer) (definition);
2205 }
2206 else if (EQ (XCONS (tail)->car, Qkeymap))
2207 {
2208 /* The same keymap might be in the structure twice, if we're
2209 using an inherited keymap. So skip anything we've already
2210 encountered. */
2211 tem = Fassq (tail, *seen);
2212 if (CONSP (tem) && !NILP (Fequal (XCONS (tem)->car, keys)))
2213 break;
2214 *seen = Fcons (Fcons (tail, keys), *seen);
2215 }
2216 }
2217
2218 UNGCPRO;
2219 }
2220
2221 static int
2222 describe_vector_princ (elt)
2223 Lisp_Object elt;
2224 {
2225 Findent_to (make_number (16), make_number (1));
2226 Fprinc (elt, Qnil);
2227 Fterpri (Qnil);
2228 }
2229
2230 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2231 "Insert a description of contents of VECTOR.\n\
2232 This is text showing the elements of vector matched against indices.")
2233 (vector)
2234 Lisp_Object vector;
2235 {
2236 int count = specpdl_ptr - specpdl;
2237
2238 specbind (Qstandard_output, Fcurrent_buffer ());
2239 CHECK_VECTOR (vector, 0);
2240 describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil);
2241
2242 return unbind_to (count, Qnil);
2243 }
2244
2245 describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
2246 register Lisp_Object vector;
2247 Lisp_Object elt_prefix;
2248 int (*elt_describer) ();
2249 int partial;
2250 Lisp_Object shadow;
2251 {
2252 Lisp_Object this;
2253 Lisp_Object dummy;
2254 Lisp_Object tem1, tem2;
2255 register int i;
2256 Lisp_Object suppress;
2257 Lisp_Object kludge;
2258 int first = 1;
2259 struct gcpro gcpro1, gcpro2, gcpro3;
2260
2261 tem1 = Qnil;
2262
2263 /* This vector gets used to present single keys to Flookup_key. Since
2264 that is done once per vector element, we don't want to cons up a
2265 fresh vector every time. */
2266 kludge = Fmake_vector (make_number (1), Qnil);
2267 GCPRO3 (elt_prefix, tem1, kludge);
2268
2269 if (partial)
2270 suppress = intern ("suppress-keymap");
2271
2272 for (i = 0; i < XVECTOR (vector)->size; i++)
2273 {
2274 QUIT;
2275 tem1 = get_keyelt (XVECTOR (vector)->contents[i], 0);
2276
2277 if (NILP (tem1)) continue;
2278
2279 /* Don't mention suppressed commands. */
2280 if (SYMBOLP (tem1) && partial)
2281 {
2282 this = Fget (tem1, suppress);
2283 if (!NILP (this))
2284 continue;
2285 }
2286
2287 /* If this command in this map is shadowed by some other map,
2288 ignore it. */
2289 if (!NILP (shadow))
2290 {
2291 Lisp_Object tem;
2292
2293 XVECTOR (kludge)->contents[0] = make_number (i);
2294 tem = shadow_lookup (shadow, kludge, Qt);
2295
2296 if (!NILP (tem)) continue;
2297 }
2298
2299 if (first)
2300 {
2301 insert ("\n", 1);
2302 first = 0;
2303 }
2304
2305 /* Output the prefix that applies to every entry in this map. */
2306 if (!NILP (elt_prefix))
2307 insert1 (elt_prefix);
2308
2309 /* Get the string to describe the character I, and print it. */
2310 XFASTINT (dummy) = i;
2311
2312 /* THIS gets the string to describe the character DUMMY. */
2313 this = Fsingle_key_description (dummy);
2314 insert1 (this);
2315
2316 /* Find all consecutive characters that have the same definition. */
2317 while (i + 1 < XVECTOR (vector)->size
2318 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1], 0),
2319 EQ (tem2, tem1)))
2320 i++;
2321
2322 /* If we have a range of more than one character,
2323 print where the range reaches to. */
2324
2325 if (i != XINT (dummy))
2326 {
2327 insert (" .. ", 4);
2328 if (!NILP (elt_prefix))
2329 insert1 (elt_prefix);
2330
2331 XFASTINT (dummy) = i;
2332 insert1 (Fsingle_key_description (dummy));
2333 }
2334
2335 /* Print a description of the definition of this character.
2336 elt_describer will take care of spacing out far enough
2337 for alignment purposes. */
2338 (*elt_describer) (tem1);
2339 }
2340
2341 UNGCPRO;
2342 }
2343 \f
2344 /* Apropos - finding all symbols whose names match a regexp. */
2345 Lisp_Object apropos_predicate;
2346 Lisp_Object apropos_accumulate;
2347
2348 static void
2349 apropos_accum (symbol, string)
2350 Lisp_Object symbol, string;
2351 {
2352 register Lisp_Object tem;
2353
2354 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
2355 if (!NILP (tem) && !NILP (apropos_predicate))
2356 tem = call1 (apropos_predicate, symbol);
2357 if (!NILP (tem))
2358 apropos_accumulate = Fcons (symbol, apropos_accumulate);
2359 }
2360
2361 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
2362 "Show all symbols whose names contain match for REGEXP.\n\
2363 If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\
2364 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
2365 Return list of symbols found.")
2366 (string, pred)
2367 Lisp_Object string, pred;
2368 {
2369 struct gcpro gcpro1, gcpro2;
2370 CHECK_STRING (string, 0);
2371 apropos_predicate = pred;
2372 GCPRO2 (apropos_predicate, apropos_accumulate);
2373 apropos_accumulate = Qnil;
2374 map_obarray (Vobarray, apropos_accum, string);
2375 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
2376 UNGCPRO;
2377 return apropos_accumulate;
2378 }
2379 \f
2380 syms_of_keymap ()
2381 {
2382 Lisp_Object tem;
2383
2384 Qkeymap = intern ("keymap");
2385 staticpro (&Qkeymap);
2386
2387 /* Initialize the keymaps standardly used.
2388 Each one is the value of a Lisp variable, and is also
2389 pointed to by a C variable */
2390
2391 global_map = Fcons (Qkeymap,
2392 Fcons (Fmake_vector (make_number (0400), Qnil), Qnil));
2393 Fset (intern ("global-map"), global_map);
2394
2395 meta_map = Fmake_keymap (Qnil);
2396 Fset (intern ("esc-map"), meta_map);
2397 Ffset (intern ("ESC-prefix"), meta_map);
2398
2399 control_x_map = Fmake_keymap (Qnil);
2400 Fset (intern ("ctl-x-map"), control_x_map);
2401 Ffset (intern ("Control-X-prefix"), control_x_map);
2402
2403 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
2404 "Default keymap to use when reading from the minibuffer.");
2405 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
2406
2407 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
2408 "Local keymap for the minibuffer when spaces are not allowed.");
2409 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
2410
2411 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
2412 "Local keymap for minibuffer input with completion.");
2413 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
2414
2415 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
2416 "Local keymap for minibuffer input with completion, for exact match.");
2417 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
2418
2419 current_global_map = global_map;
2420
2421 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
2422 "Alist of keymaps to use for minor modes.\n\
2423 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
2424 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
2425 If two active keymaps bind the same key, the keymap appearing earlier\n\
2426 in the list takes precedence.");
2427 Vminor_mode_map_alist = Qnil;
2428
2429 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
2430 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
2431 This allows Emacs to recognize function keys sent from ASCII\n\
2432 terminals at any point in a key sequence.\n\
2433 \n\
2434 The `read-key-sequence' function replaces any subsequence bound by\n\
2435 `function-key-map' with its binding. More precisely, when the active\n\
2436 keymaps have no binding for the current key sequence but\n\
2437 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
2438 `read-key-sequence' replaces the matching suffix with its binding, and\n\
2439 continues with the new sequence.\n\
2440 \n\
2441 The events that come from bindings in `function-key-map' are not\n\
2442 themselves looked up in `function-key-map'.\n\
2443 \n\
2444 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
2445 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
2446 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
2447 key, typing `ESC O P x' would return [f1 x].");
2448 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
2449
2450 Qsingle_key_description = intern ("single-key-description");
2451 staticpro (&Qsingle_key_description);
2452
2453 Qkey_description = intern ("key-description");
2454 staticpro (&Qkey_description);
2455
2456 Qkeymapp = intern ("keymapp");
2457 staticpro (&Qkeymapp);
2458
2459 Qnon_ascii = intern ("non-ascii");
2460 staticpro (&Qnon_ascii);
2461
2462 defsubr (&Skeymapp);
2463 defsubr (&Smake_keymap);
2464 defsubr (&Smake_sparse_keymap);
2465 defsubr (&Scopy_keymap);
2466 defsubr (&Skey_binding);
2467 defsubr (&Slocal_key_binding);
2468 defsubr (&Sglobal_key_binding);
2469 defsubr (&Sminor_mode_key_binding);
2470 defsubr (&Sglobal_set_key);
2471 defsubr (&Slocal_set_key);
2472 defsubr (&Sdefine_key);
2473 defsubr (&Slookup_key);
2474 defsubr (&Sglobal_unset_key);
2475 defsubr (&Slocal_unset_key);
2476 defsubr (&Sdefine_prefix_command);
2477 defsubr (&Suse_global_map);
2478 defsubr (&Suse_local_map);
2479 defsubr (&Scurrent_local_map);
2480 defsubr (&Scurrent_global_map);
2481 defsubr (&Scurrent_minor_mode_maps);
2482 defsubr (&Saccessible_keymaps);
2483 defsubr (&Skey_description);
2484 defsubr (&Sdescribe_vector);
2485 defsubr (&Ssingle_key_description);
2486 defsubr (&Stext_char_description);
2487 defsubr (&Swhere_is_internal);
2488 defsubr (&Sdescribe_bindings);
2489 defsubr (&Sapropos_internal);
2490 }
2491
2492 keys_of_keymap ()
2493 {
2494 Lisp_Object tem;
2495
2496 initial_define_key (global_map, 033, "ESC-prefix");
2497 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
2498 }