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