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