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