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