(Fuse_global_map, Fuse_local_map): Don't call record_asynch_buffer_change.
[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
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
1089 return Qnil;
1090 }
1091
1092 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1093 "Return current buffer's local keymap, or nil if it has none.")
1094 ()
1095 {
1096 return current_buffer->keymap;
1097 }
1098
1099 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1100 "Return the current global keymap.")
1101 ()
1102 {
1103 return current_global_map;
1104 }
1105
1106 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1107 "Return a list of keymaps for the minor modes of the current buffer.")
1108 ()
1109 {
1110 Lisp_Object *maps;
1111 int nmaps = current_minor_maps (0, &maps);
1112
1113 return Flist (nmaps, maps);
1114 }
1115 \f
1116 /* Help functions for describing and documenting keymaps. */
1117
1118 /* This function cannot GC. */
1119
1120 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1121 1, 2, 0,
1122 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1123 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1124 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1125 so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
1126 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1127 then the value includes only maps for prefixes that start with PREFIX.")
1128 (keymap, prefix)
1129 Lisp_Object keymap, prefix;
1130 {
1131 Lisp_Object maps, good_maps, tail;
1132 int prefixlen = 0;
1133
1134 /* no need for gcpro because we don't autoload any keymaps. */
1135
1136 if (!NILP (prefix))
1137 prefixlen = XINT (Flength (prefix));
1138
1139 if (!NILP (prefix))
1140 {
1141 /* If a prefix was specified, start with the keymap (if any) for
1142 that prefix, so we don't waste time considering other prefixes. */
1143 Lisp_Object tem;
1144 tem = Flookup_key (keymap, prefix, Qt);
1145 /* Flookup_key may give us nil, or a number,
1146 if the prefix is not defined in this particular map.
1147 It might even give us a list that isn't a keymap. */
1148 tem = get_keymap_1 (tem, 0, 0);
1149 if (!NILP (tem))
1150 maps = Fcons (Fcons (prefix, tem), Qnil);
1151 else
1152 return Qnil;
1153 }
1154 else
1155 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1156 get_keymap (keymap)),
1157 Qnil);
1158
1159 /* For each map in the list maps,
1160 look at any other maps it points to,
1161 and stick them at the end if they are not already in the list.
1162
1163 This is a breadth-first traversal, where tail is the queue of
1164 nodes, and maps accumulates a list of all nodes visited. */
1165
1166 for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr)
1167 {
1168 register Lisp_Object thisseq, thismap;
1169 Lisp_Object last;
1170 /* Does the current sequence end in the meta-prefix-char? */
1171 int is_metized;
1172
1173 thisseq = Fcar (Fcar (tail));
1174 thismap = Fcdr (Fcar (tail));
1175 last = make_number (XINT (Flength (thisseq)) - 1);
1176 is_metized = (XINT (last) >= 0
1177 && EQ (Faref (thisseq, last), meta_prefix_char));
1178
1179 for (; CONSP (thismap); thismap = XCONS (thismap)->cdr)
1180 {
1181 Lisp_Object elt;
1182
1183 elt = XCONS (thismap)->car;
1184
1185 QUIT;
1186
1187 if (VECTORP (elt))
1188 {
1189 register int i;
1190
1191 /* Vector keymap. Scan all the elements. */
1192 for (i = 0; i < XVECTOR (elt)->size; i++)
1193 {
1194 register Lisp_Object tem;
1195 register Lisp_Object cmd;
1196
1197 cmd = get_keyelt (XVECTOR (elt)->contents[i], 0);
1198 if (NILP (cmd)) continue;
1199 tem = Fkeymapp (cmd);
1200 if (!NILP (tem))
1201 {
1202 cmd = get_keymap (cmd);
1203 /* Ignore keymaps that are already added to maps. */
1204 tem = Frassq (cmd, maps);
1205 if (NILP (tem))
1206 {
1207 /* If the last key in thisseq is meta-prefix-char,
1208 turn it into a meta-ized keystroke. We know
1209 that the event we're about to append is an
1210 ascii keystroke since we're processing a
1211 keymap table. */
1212 if (is_metized)
1213 {
1214 int meta_bit = meta_modifier;
1215 tem = Fcopy_sequence (thisseq);
1216
1217 Faset (tem, last, make_number (i | meta_bit));
1218
1219 /* This new sequence is the same length as
1220 thisseq, so stick it in the list right
1221 after this one. */
1222 XCONS (tail)->cdr
1223 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
1224 }
1225 else
1226 {
1227 tem = append_key (thisseq, make_number (i));
1228 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1229 }
1230 }
1231 }
1232 }
1233 }
1234 else if (CONSP (elt))
1235 {
1236 register Lisp_Object cmd, tem, filter;
1237
1238 cmd = get_keyelt (XCONS (elt)->cdr, 0);
1239 /* Ignore definitions that aren't keymaps themselves. */
1240 tem = Fkeymapp (cmd);
1241 if (!NILP (tem))
1242 {
1243 /* Ignore keymaps that have been seen already. */
1244 cmd = get_keymap (cmd);
1245 tem = Frassq (cmd, maps);
1246 if (NILP (tem))
1247 {
1248 /* Let elt be the event defined by this map entry. */
1249 elt = XCONS (elt)->car;
1250
1251 /* If the last key in thisseq is meta-prefix-char, and
1252 this entry is a binding for an ascii keystroke,
1253 turn it into a meta-ized keystroke. */
1254 if (is_metized && INTEGERP (elt))
1255 {
1256 tem = Fcopy_sequence (thisseq);
1257 Faset (tem, last,
1258 make_number (XINT (elt) | meta_modifier));
1259
1260 /* This new sequence is the same length as
1261 thisseq, so stick it in the list right
1262 after this one. */
1263 XCONS (tail)->cdr
1264 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
1265 }
1266 else
1267 nconc2 (tail,
1268 Fcons (Fcons (append_key (thisseq, elt), cmd),
1269 Qnil));
1270 }
1271 }
1272 }
1273 }
1274 }
1275
1276 if (NILP (prefix))
1277 return maps;
1278
1279 /* Now find just the maps whose access prefixes start with PREFIX. */
1280
1281 good_maps = Qnil;
1282 for (; CONSP (maps); maps = XCONS (maps)->cdr)
1283 {
1284 Lisp_Object elt, thisseq;
1285 elt = XCONS (maps)->car;
1286 thisseq = XCONS (elt)->car;
1287 /* The access prefix must be at least as long as PREFIX,
1288 and the first elements must match those of PREFIX. */
1289 if (XINT (Flength (thisseq)) >= prefixlen)
1290 {
1291 int i;
1292 for (i = 0; i < prefixlen; i++)
1293 {
1294 Lisp_Object i1;
1295 XSETFASTINT (i1, i);
1296 if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1297 break;
1298 }
1299 if (i == prefixlen)
1300 good_maps = Fcons (elt, good_maps);
1301 }
1302 }
1303
1304 return Fnreverse (good_maps);
1305 }
1306
1307 Lisp_Object Qsingle_key_description, Qkey_description;
1308
1309 /* This function cannot GC. */
1310
1311 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1312 "Return a pretty description of key-sequence KEYS.\n\
1313 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1314 spaces are put between sequence elements, etc.")
1315 (keys)
1316 Lisp_Object keys;
1317 {
1318 int len;
1319 int i;
1320 Lisp_Object sep;
1321 Lisp_Object *args;
1322
1323 if (STRINGP (keys))
1324 {
1325 Lisp_Object vector;
1326 vector = Fmake_vector (Flength (keys), Qnil);
1327 for (i = 0; i < XSTRING (keys)->size; i++)
1328 {
1329 if (XSTRING (keys)->data[i] & 0x80)
1330 XSETFASTINT (XVECTOR (vector)->contents[i],
1331 meta_modifier | (XSTRING (keys)->data[i] & ~0x80));
1332 else
1333 XSETFASTINT (XVECTOR (vector)->contents[i],
1334 XSTRING (keys)->data[i]);
1335 }
1336 keys = vector;
1337 }
1338 else if (!VECTORP (keys))
1339 keys = wrong_type_argument (Qarrayp, keys);
1340
1341 /* In effect, this computes
1342 (mapconcat 'single-key-description keys " ")
1343 but we shouldn't use mapconcat because it can do GC. */
1344
1345 len = XVECTOR (keys)->size;
1346 sep = build_string (" ");
1347 /* This has one extra element at the end that we don't pass to Fconcat. */
1348 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1349
1350 for (i = 0; i < len; i++)
1351 {
1352 args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
1353 args[i * 2 + 1] = sep;
1354 }
1355
1356 return Fconcat (len * 2 - 1, args);
1357 }
1358
1359 char *
1360 push_key_description (c, p)
1361 register unsigned int c;
1362 register char *p;
1363 {
1364 /* Clear all the meaningless bits above the meta bit. */
1365 c &= meta_modifier | ~ - meta_modifier;
1366
1367 if (c & alt_modifier)
1368 {
1369 *p++ = 'A';
1370 *p++ = '-';
1371 c -= alt_modifier;
1372 }
1373 if (c & ctrl_modifier)
1374 {
1375 *p++ = 'C';
1376 *p++ = '-';
1377 c -= ctrl_modifier;
1378 }
1379 if (c & hyper_modifier)
1380 {
1381 *p++ = 'H';
1382 *p++ = '-';
1383 c -= hyper_modifier;
1384 }
1385 if (c & meta_modifier)
1386 {
1387 *p++ = 'M';
1388 *p++ = '-';
1389 c -= meta_modifier;
1390 }
1391 if (c & shift_modifier)
1392 {
1393 *p++ = 'S';
1394 *p++ = '-';
1395 c -= shift_modifier;
1396 }
1397 if (c & super_modifier)
1398 {
1399 *p++ = 's';
1400 *p++ = '-';
1401 c -= super_modifier;
1402 }
1403 if (c < 040)
1404 {
1405 if (c == 033)
1406 {
1407 *p++ = 'E';
1408 *p++ = 'S';
1409 *p++ = 'C';
1410 }
1411 else if (c == '\t')
1412 {
1413 *p++ = 'T';
1414 *p++ = 'A';
1415 *p++ = 'B';
1416 }
1417 else if (c == Ctl('J'))
1418 {
1419 *p++ = 'L';
1420 *p++ = 'F';
1421 *p++ = 'D';
1422 }
1423 else if (c == Ctl('M'))
1424 {
1425 *p++ = 'R';
1426 *p++ = 'E';
1427 *p++ = 'T';
1428 }
1429 else
1430 {
1431 *p++ = 'C';
1432 *p++ = '-';
1433 if (c > 0 && c <= Ctl ('Z'))
1434 *p++ = c + 0140;
1435 else
1436 *p++ = c + 0100;
1437 }
1438 }
1439 else if (c == 0177)
1440 {
1441 *p++ = 'D';
1442 *p++ = 'E';
1443 *p++ = 'L';
1444 }
1445 else if (c == ' ')
1446 {
1447 *p++ = 'S';
1448 *p++ = 'P';
1449 *p++ = 'C';
1450 }
1451 else if (c < 256)
1452 *p++ = c;
1453 else
1454 {
1455 *p++ = '\\';
1456 *p++ = (7 & (c >> 15)) + '0';
1457 *p++ = (7 & (c >> 12)) + '0';
1458 *p++ = (7 & (c >> 9)) + '0';
1459 *p++ = (7 & (c >> 6)) + '0';
1460 *p++ = (7 & (c >> 3)) + '0';
1461 *p++ = (7 & (c >> 0)) + '0';
1462 }
1463
1464 return p;
1465 }
1466
1467 /* This function cannot GC. */
1468
1469 DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
1470 "Return a pretty description of command character KEY.\n\
1471 Control characters turn into C-whatever, etc.")
1472 (key)
1473 Lisp_Object key;
1474 {
1475 char tem[20];
1476
1477 key = EVENT_HEAD (key);
1478
1479 if (INTEGERP (key)) /* Normal character */
1480 {
1481 *push_key_description (XUINT (key), tem) = 0;
1482 return build_string (tem);
1483 }
1484 else if (SYMBOLP (key)) /* Function key or event-symbol */
1485 return Fsymbol_name (key);
1486 else if (STRINGP (key)) /* Buffer names in the menubar. */
1487 return Fcopy_sequence (key);
1488 else
1489 error ("KEY must be an integer, cons, symbol, or string");
1490 }
1491
1492 char *
1493 push_text_char_description (c, p)
1494 register unsigned int c;
1495 register char *p;
1496 {
1497 if (c >= 0200)
1498 {
1499 *p++ = 'M';
1500 *p++ = '-';
1501 c -= 0200;
1502 }
1503 if (c < 040)
1504 {
1505 *p++ = '^';
1506 *p++ = c + 64; /* 'A' - 1 */
1507 }
1508 else if (c == 0177)
1509 {
1510 *p++ = '^';
1511 *p++ = '?';
1512 }
1513 else
1514 *p++ = c;
1515 return p;
1516 }
1517
1518 /* This function cannot GC. */
1519
1520 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1521 "Return a pretty description of file-character CHARACTER.\n\
1522 Control characters turn into \"^char\", etc.")
1523 (character)
1524 Lisp_Object character;
1525 {
1526 char tem[6];
1527
1528 CHECK_NUMBER (character, 0);
1529
1530 *push_text_char_description (XINT (character) & 0377, tem) = 0;
1531
1532 return build_string (tem);
1533 }
1534
1535 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
1536 a meta bit. */
1537 static int
1538 ascii_sequence_p (seq)
1539 Lisp_Object seq;
1540 {
1541 int i;
1542 int len = XINT (Flength (seq));
1543
1544 for (i = 0; i < len; i++)
1545 {
1546 Lisp_Object ii, elt;
1547
1548 XSETFASTINT (ii, i);
1549 elt = Faref (seq, ii);
1550
1551 if (!INTEGERP (elt)
1552 || (XUINT (elt) & ~CHAR_META) >= 0x80)
1553 return 0;
1554 }
1555
1556 return 1;
1557 }
1558
1559 \f
1560 /* where-is - finding a command in a set of keymaps. */
1561
1562 /* This function can GC if Flookup_key autoloads any keymaps. */
1563
1564 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
1565 "Return list of keys that invoke DEFINITION.\n\
1566 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
1567 If KEYMAP is nil, search all the currently active keymaps.\n\
1568 \n\
1569 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
1570 rather than a list of all possible key sequences.\n\
1571 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
1572 no matter what it is.\n\
1573 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
1574 and entirely reject menu bindings.\n\
1575 \n\
1576 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
1577 to other keymaps or slots. This makes it possible to search for an\n\
1578 indirect definition itself.")
1579 (definition, keymap, firstonly, noindirect)
1580 Lisp_Object definition, keymap;
1581 Lisp_Object firstonly, noindirect;
1582 {
1583 Lisp_Object maps;
1584 Lisp_Object found, sequence;
1585 int keymap_specified = !NILP (keymap);
1586 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1587 /* 1 means ignore all menu bindings entirely. */
1588 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
1589
1590 if (! keymap_specified)
1591 {
1592 #ifdef USE_TEXT_PROPERTIES
1593 keymap = get_local_map (PT, current_buffer);
1594 #else
1595 keymap = current_buffer->keymap;
1596 #endif
1597 }
1598
1599 if (!NILP (keymap))
1600 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil),
1601 Faccessible_keymaps (get_keymap (current_global_map),
1602 Qnil));
1603 else
1604 maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
1605
1606 /* Put the minor mode keymaps on the front. */
1607 if (! keymap_specified)
1608 {
1609 Lisp_Object minors;
1610 minors = Fnreverse (Fcurrent_minor_mode_maps ());
1611 while (!NILP (minors))
1612 {
1613 maps = nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors)->car),
1614 Qnil),
1615 maps);
1616 minors = XCONS (minors)->cdr;
1617 }
1618 }
1619
1620 GCPRO5 (definition, keymap, maps, found, sequence);
1621 found = Qnil;
1622 sequence = Qnil;
1623
1624 for (; !NILP (maps); maps = Fcdr (maps))
1625 {
1626 /* Key sequence to reach map, and the map that it reaches */
1627 register Lisp_Object this, map;
1628
1629 /* If Fcar (map) is a VECTOR, the current element within that vector. */
1630 int i = 0;
1631
1632 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1633 [M-CHAR] sequences, check if last character of the sequence
1634 is the meta-prefix char. */
1635 Lisp_Object last;
1636 int last_is_meta;
1637
1638 this = Fcar (Fcar (maps));
1639 map = Fcdr (Fcar (maps));
1640 last = make_number (XINT (Flength (this)) - 1);
1641 last_is_meta = (XINT (last) >= 0
1642 && EQ (Faref (this, last), meta_prefix_char));
1643
1644 QUIT;
1645
1646 while (CONSP (map))
1647 {
1648 /* Because the code we want to run on each binding is rather
1649 large, we don't want to have two separate loop bodies for
1650 sparse keymap bindings and tables; we want to iterate one
1651 loop body over both keymap and vector bindings.
1652
1653 For this reason, if Fcar (map) is a vector, we don't
1654 advance map to the next element until i indicates that we
1655 have finished off the vector. */
1656
1657 Lisp_Object elt, key, binding;
1658 elt = XCONS (map)->car;
1659
1660 QUIT;
1661
1662 /* Set key and binding to the current key and binding, and
1663 advance map and i to the next binding. */
1664 if (VECTORP (elt))
1665 {
1666 /* In a vector, look at each element. */
1667 binding = XVECTOR (elt)->contents[i];
1668 XSETFASTINT (key, i);
1669 i++;
1670
1671 /* If we've just finished scanning a vector, advance map
1672 to the next element, and reset i in anticipation of the
1673 next vector we may find. */
1674 if (i >= XVECTOR (elt)->size)
1675 {
1676 map = XCONS (map)->cdr;
1677 i = 0;
1678 }
1679 }
1680 else if (CONSP (elt))
1681 {
1682 key = Fcar (Fcar (map));
1683 binding = Fcdr (Fcar (map));
1684
1685 map = XCONS (map)->cdr;
1686 }
1687 else
1688 /* We want to ignore keymap elements that are neither
1689 vectors nor conses. */
1690 {
1691 map = XCONS (map)->cdr;
1692 continue;
1693 }
1694
1695 /* Search through indirections unless that's not wanted. */
1696 if (NILP (noindirect))
1697 {
1698 if (nomenus)
1699 {
1700 while (1)
1701 {
1702 Lisp_Object map, tem;
1703 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1704 map = get_keymap_1 (Fcar_safe (definition), 0, 0);
1705 tem = Fkeymapp (map);
1706 if (!NILP (tem))
1707 definition = access_keymap (map, Fcdr (definition), 0, 0);
1708 else
1709 break;
1710 }
1711 /* If the contents are (STRING ...), reject. */
1712 if (CONSP (definition)
1713 && STRINGP (XCONS (definition)->car))
1714 continue;
1715 }
1716 else
1717 binding = get_keyelt (binding, 0);
1718 }
1719
1720 /* End this iteration if this element does not match
1721 the target. */
1722
1723 if (CONSP (definition))
1724 {
1725 Lisp_Object tem;
1726 tem = Fequal (binding, definition);
1727 if (NILP (tem))
1728 continue;
1729 }
1730 else
1731 if (!EQ (binding, definition))
1732 continue;
1733
1734 /* We have found a match.
1735 Construct the key sequence where we found it. */
1736 if (INTEGERP (key) && last_is_meta)
1737 {
1738 sequence = Fcopy_sequence (this);
1739 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
1740 }
1741 else
1742 sequence = append_key (this, key);
1743
1744 /* Verify that this key binding is not shadowed by another
1745 binding for the same key, before we say it exists.
1746
1747 Mechanism: look for local definition of this key and if
1748 it is defined and does not match what we found then
1749 ignore this key.
1750
1751 Either nil or number as value from Flookup_key
1752 means undefined. */
1753 if (keymap_specified)
1754 {
1755 binding = Flookup_key (keymap, sequence, Qnil);
1756 if (!NILP (binding) && !INTEGERP (binding))
1757 {
1758 if (CONSP (definition))
1759 {
1760 Lisp_Object tem;
1761 tem = Fequal (binding, definition);
1762 if (NILP (tem))
1763 continue;
1764 }
1765 else
1766 if (!EQ (binding, definition))
1767 continue;
1768 }
1769 }
1770 else
1771 {
1772 binding = Fkey_binding (sequence, Qnil);
1773 if (!EQ (binding, definition))
1774 continue;
1775 }
1776
1777 /* It is a true unshadowed match. Record it, unless it's already
1778 been seen (as could happen when inheriting keymaps). */
1779 if (NILP (Fmember (sequence, found)))
1780 found = Fcons (sequence, found);
1781
1782 /* If firstonly is Qnon_ascii, then we can return the first
1783 binding we find. If firstonly is not Qnon_ascii but not
1784 nil, then we should return the first ascii-only binding
1785 we find. */
1786 if (EQ (firstonly, Qnon_ascii))
1787 RETURN_UNGCPRO (sequence);
1788 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
1789 RETURN_UNGCPRO (sequence);
1790 }
1791 }
1792
1793 UNGCPRO;
1794
1795 found = Fnreverse (found);
1796
1797 /* firstonly may have been t, but we may have gone all the way through
1798 the keymaps without finding an all-ASCII key sequence. So just
1799 return the best we could find. */
1800 if (! NILP (firstonly))
1801 return Fcar (found);
1802
1803 return found;
1804 }
1805 \f
1806 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
1807
1808 DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
1809 "Show a list of all defined keys, and their definitions.\n\
1810 The list is put in a buffer, which is displayed.\n\
1811 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1812 then we display only bindings that start with that prefix.")
1813 (prefix)
1814 Lisp_Object prefix;
1815 {
1816 register Lisp_Object thisbuf;
1817 XSETBUFFER (thisbuf, current_buffer);
1818 internal_with_output_to_temp_buffer ("*Help*",
1819 describe_buffer_bindings,
1820 Fcons (thisbuf, prefix));
1821 return Qnil;
1822 }
1823
1824 /* ARG is (BUFFER . PREFIX). */
1825
1826 static Lisp_Object
1827 describe_buffer_bindings (arg)
1828 Lisp_Object arg;
1829 {
1830 Lisp_Object descbuf, prefix, shadow;
1831 register Lisp_Object start1;
1832 struct gcpro gcpro1;
1833
1834 char *alternate_heading
1835 = "\
1836 Alternate Characters (use anywhere the nominal character is listed):\n\
1837 nominal alternate\n\
1838 ------- ---------\n";
1839
1840 descbuf = XCONS (arg)->car;
1841 prefix = XCONS (arg)->cdr;
1842 shadow = Qnil;
1843 GCPRO1 (shadow);
1844
1845 Fset_buffer (Vstandard_output);
1846
1847 /* Report on alternates for keys. */
1848 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
1849 {
1850 int c;
1851 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
1852 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
1853
1854 for (c = 0; c < translate_len; c++)
1855 if (translate[c] != c)
1856 {
1857 char buf[20];
1858 char *bufend;
1859
1860 if (alternate_heading)
1861 {
1862 insert_string (alternate_heading);
1863 alternate_heading = 0;
1864 }
1865
1866 bufend = push_key_description (translate[c], buf);
1867 insert (buf, bufend - buf);
1868 Findent_to (make_number (16), make_number (1));
1869 bufend = push_key_description (c, buf);
1870 insert (buf, bufend - buf);
1871
1872 insert ("\n", 1);
1873 }
1874
1875 insert ("\n", 1);
1876 }
1877
1878 if (!NILP (Vkey_translation_map))
1879 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
1880 "Key translations", 0, 1, 0);
1881
1882 {
1883 int i, nmaps;
1884 Lisp_Object *modes, *maps;
1885
1886 /* Temporarily switch to descbuf, so that we can get that buffer's
1887 minor modes correctly. */
1888 Fset_buffer (descbuf);
1889
1890 if (!NILP (current_kboard->Voverriding_terminal_local_map)
1891 || !NILP (Voverriding_local_map))
1892 nmaps = 0;
1893 else
1894 nmaps = current_minor_maps (&modes, &maps);
1895 Fset_buffer (Vstandard_output);
1896
1897 /* Print the minor mode maps. */
1898 for (i = 0; i < nmaps; i++)
1899 {
1900 /* The title for a minor mode keymap
1901 is constructed at run time.
1902 We let describe_map_tree do the actual insertion
1903 because it takes care of other features when doing so. */
1904 char *title, *p;
1905
1906 if (!SYMBOLP (modes[i]))
1907 abort();
1908
1909 p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
1910 *p++ = '`';
1911 bcopy (XSYMBOL (modes[i])->name->data, p,
1912 XSYMBOL (modes[i])->name->size);
1913 p += XSYMBOL (modes[i])->name->size;
1914 *p++ = '\'';
1915 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
1916 p += sizeof (" Minor Mode Bindings") - 1;
1917 *p = 0;
1918
1919 describe_map_tree (maps[i], 0, shadow, prefix, title, 0, 0, 0);
1920 shadow = Fcons (maps[i], shadow);
1921 }
1922 }
1923
1924 /* Print the (major mode) local map. */
1925 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1926 start1 = current_kboard->Voverriding_terminal_local_map;
1927 else if (!NILP (Voverriding_local_map))
1928 start1 = Voverriding_local_map;
1929 else
1930 start1 = XBUFFER (descbuf)->keymap;
1931
1932 if (!NILP (start1))
1933 {
1934 describe_map_tree (start1, 0, shadow, prefix,
1935 "Major Mode Bindings", 0, 0, 0);
1936 shadow = Fcons (start1, shadow);
1937 }
1938
1939 describe_map_tree (current_global_map, 0, shadow, prefix,
1940 "Global Bindings", 0, 0, 1);
1941
1942 /* Print the function-key-map translations under this prefix. */
1943 if (!NILP (Vfunction_key_map))
1944 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
1945 "Function key map translations", 0, 1, 0);
1946
1947 call0 (intern ("help-mode"));
1948 Fset_buffer (descbuf);
1949 UNGCPRO;
1950 return Qnil;
1951 }
1952
1953 /* Insert a description of the key bindings in STARTMAP,
1954 followed by those of all maps reachable through STARTMAP.
1955 If PARTIAL is nonzero, omit certain "uninteresting" commands
1956 (such as `undefined').
1957 If SHADOW is non-nil, it is a list of maps;
1958 don't mention keys which would be shadowed by any of them.
1959 PREFIX, if non-nil, says mention only keys that start with PREFIX.
1960 TITLE, if not 0, is a string to insert at the beginning.
1961 TITLE should not end with a colon or a newline; we supply that.
1962 If NOMENU is not 0, then omit menu-bar commands.
1963
1964 If TRANSL is nonzero, the definitions are actually key translations
1965 so print strings and vectors differently.
1966
1967 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
1968 to look through. */
1969
1970 void
1971 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
1972 always_title)
1973 Lisp_Object startmap, shadow, prefix;
1974 int partial;
1975 char *title;
1976 int nomenu;
1977 int transl;
1978 int always_title;
1979 {
1980 Lisp_Object maps, seen, sub_shadows;
1981 struct gcpro gcpro1, gcpro2, gcpro3;
1982 int something = 0;
1983 char *key_heading
1984 = "\
1985 key binding\n\
1986 --- -------\n";
1987
1988 maps = Faccessible_keymaps (startmap, prefix);
1989 seen = Qnil;
1990 sub_shadows = Qnil;
1991 GCPRO3 (maps, seen, sub_shadows);
1992
1993 if (nomenu)
1994 {
1995 Lisp_Object list;
1996
1997 /* Delete from MAPS each element that is for the menu bar. */
1998 for (list = maps; !NILP (list); list = XCONS (list)->cdr)
1999 {
2000 Lisp_Object elt, prefix, tem;
2001
2002 elt = Fcar (list);
2003 prefix = Fcar (elt);
2004 if (XVECTOR (prefix)->size >= 1)
2005 {
2006 tem = Faref (prefix, make_number (0));
2007 if (EQ (tem, Qmenu_bar))
2008 maps = Fdelq (elt, maps);
2009 }
2010 }
2011 }
2012
2013 if (!NILP (maps) || always_title)
2014 {
2015 if (title)
2016 {
2017 insert_string (title);
2018 if (!NILP (prefix))
2019 {
2020 insert_string (" Starting With ");
2021 insert1 (Fkey_description (prefix));
2022 }
2023 insert_string (":\n");
2024 }
2025 insert_string (key_heading);
2026 something = 1;
2027 }
2028
2029 for (; !NILP (maps); maps = Fcdr (maps))
2030 {
2031 register Lisp_Object elt, prefix, tail;
2032
2033 elt = Fcar (maps);
2034 prefix = Fcar (elt);
2035
2036 sub_shadows = Qnil;
2037
2038 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2039 {
2040 Lisp_Object shmap;
2041
2042 shmap = XCONS (tail)->car;
2043
2044 /* If the sequence by which we reach this keymap is zero-length,
2045 then the shadow map for this keymap is just SHADOW. */
2046 if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
2047 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
2048 ;
2049 /* If the sequence by which we reach this keymap actually has
2050 some elements, then the sequence's definition in SHADOW is
2051 what we should use. */
2052 else
2053 {
2054 shmap = Flookup_key (shmap, Fcar (elt), Qt);
2055 if (INTEGERP (shmap))
2056 shmap = Qnil;
2057 }
2058
2059 /* If shmap is not nil and not a keymap,
2060 it completely shadows this map, so don't
2061 describe this map at all. */
2062 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
2063 goto skip;
2064
2065 if (!NILP (shmap))
2066 sub_shadows = Fcons (shmap, sub_shadows);
2067 }
2068
2069 describe_map (Fcdr (elt), Fcar (elt),
2070 transl ? describe_translation : describe_command,
2071 partial, sub_shadows, &seen, nomenu);
2072
2073 skip: ;
2074 }
2075
2076 if (something)
2077 insert_string ("\n");
2078
2079 UNGCPRO;
2080 }
2081
2082 static int previous_description_column;
2083
2084 static void
2085 describe_command (definition)
2086 Lisp_Object definition;
2087 {
2088 register Lisp_Object tem1;
2089 int column = current_column ();
2090 int description_column;
2091
2092 /* If column 16 is no good, go to col 32;
2093 but don't push beyond that--go to next line instead. */
2094 if (column > 30)
2095 {
2096 insert_char ('\n');
2097 description_column = 32;
2098 }
2099 else if (column > 14 || (column > 10 && previous_description_column == 32))
2100 description_column = 32;
2101 else
2102 description_column = 16;
2103
2104 Findent_to (make_number (description_column), make_number (1));
2105 previous_description_column = description_column;
2106
2107 if (SYMBOLP (definition))
2108 {
2109 XSETSTRING (tem1, XSYMBOL (definition)->name);
2110 insert1 (tem1);
2111 insert_string ("\n");
2112 }
2113 else if (STRINGP (definition) || VECTORP (definition))
2114 insert_string ("Keyboard Macro\n");
2115 else
2116 {
2117 tem1 = Fkeymapp (definition);
2118 if (!NILP (tem1))
2119 insert_string ("Prefix Command\n");
2120 else
2121 insert_string ("??\n");
2122 }
2123 }
2124
2125 static void
2126 describe_translation (definition)
2127 Lisp_Object definition;
2128 {
2129 register Lisp_Object tem1;
2130
2131 Findent_to (make_number (16), make_number (1));
2132
2133 if (SYMBOLP (definition))
2134 {
2135 XSETSTRING (tem1, XSYMBOL (definition)->name);
2136 insert1 (tem1);
2137 insert_string ("\n");
2138 }
2139 else if (STRINGP (definition) || VECTORP (definition))
2140 {
2141 insert1 (Fkey_description (definition));
2142 insert_string ("\n");
2143 }
2144 else
2145 {
2146 tem1 = Fkeymapp (definition);
2147 if (!NILP (tem1))
2148 insert_string ("Prefix Command\n");
2149 else
2150 insert_string ("??\n");
2151 }
2152 }
2153
2154 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2155 Returns the first non-nil binding found in any of those maps. */
2156
2157 static Lisp_Object
2158 shadow_lookup (shadow, key, flag)
2159 Lisp_Object shadow, key, flag;
2160 {
2161 Lisp_Object tail, value;
2162
2163 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2164 {
2165 value = Flookup_key (XCONS (tail)->car, key, flag);
2166 if (!NILP (value))
2167 return value;
2168 }
2169 return Qnil;
2170 }
2171
2172 /* Describe the contents of map MAP, assuming that this map itself is
2173 reached by the sequence of prefix keys KEYS (a string or vector).
2174 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2175
2176 static void
2177 describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
2178 register Lisp_Object map;
2179 Lisp_Object keys;
2180 int (*elt_describer) ();
2181 int partial;
2182 Lisp_Object shadow;
2183 Lisp_Object *seen;
2184 int nomenu;
2185 {
2186 Lisp_Object elt_prefix;
2187 Lisp_Object tail, definition, event;
2188 Lisp_Object tem;
2189 Lisp_Object suppress;
2190 Lisp_Object kludge;
2191 int first = 1;
2192 struct gcpro gcpro1, gcpro2, gcpro3;
2193
2194 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2195 {
2196 /* Call Fkey_description first, to avoid GC bug for the other string. */
2197 tem = Fkey_description (keys);
2198 elt_prefix = concat2 (tem, build_string (" "));
2199 }
2200 else
2201 elt_prefix = Qnil;
2202
2203 if (partial)
2204 suppress = intern ("suppress-keymap");
2205
2206 /* This vector gets used to present single keys to Flookup_key. Since
2207 that is done once per keymap element, we don't want to cons up a
2208 fresh vector every time. */
2209 kludge = Fmake_vector (make_number (1), Qnil);
2210 definition = Qnil;
2211
2212 GCPRO3 (elt_prefix, definition, kludge);
2213
2214 for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr)
2215 {
2216 QUIT;
2217
2218 if (VECTORP (XCONS (tail)->car))
2219 describe_vector (XCONS (tail)->car,
2220 elt_prefix, elt_describer, partial, shadow, map);
2221 else if (CONSP (XCONS (tail)->car))
2222 {
2223 event = XCONS (XCONS (tail)->car)->car;
2224
2225 /* Ignore bindings whose "keys" are not really valid events.
2226 (We get these in the frames and buffers menu.) */
2227 if (! (SYMBOLP (event) || INTEGERP (event)))
2228 continue;
2229
2230 if (nomenu && EQ (event, Qmenu_bar))
2231 continue;
2232
2233 definition = get_keyelt (XCONS (XCONS (tail)->car)->cdr, 0);
2234
2235 /* Don't show undefined commands or suppressed commands. */
2236 if (NILP (definition)) continue;
2237 if (SYMBOLP (definition) && partial)
2238 {
2239 tem = Fget (definition, suppress);
2240 if (!NILP (tem))
2241 continue;
2242 }
2243
2244 /* Don't show a command that isn't really visible
2245 because a local definition of the same key shadows it. */
2246
2247 XVECTOR (kludge)->contents[0] = event;
2248 if (!NILP (shadow))
2249 {
2250 tem = shadow_lookup (shadow, kludge, Qt);
2251 if (!NILP (tem)) continue;
2252 }
2253
2254 tem = Flookup_key (map, kludge, Qt);
2255 if (! EQ (tem, definition)) continue;
2256
2257 if (first)
2258 {
2259 previous_description_column = 0;
2260 insert ("\n", 1);
2261 first = 0;
2262 }
2263
2264 if (!NILP (elt_prefix))
2265 insert1 (elt_prefix);
2266
2267 /* THIS gets the string to describe the character EVENT. */
2268 insert1 (Fsingle_key_description (event));
2269
2270 /* Print a description of the definition of this character.
2271 elt_describer will take care of spacing out far enough
2272 for alignment purposes. */
2273 (*elt_describer) (definition);
2274 }
2275 else if (EQ (XCONS (tail)->car, Qkeymap))
2276 {
2277 /* The same keymap might be in the structure twice, if we're
2278 using an inherited keymap. So skip anything we've already
2279 encountered. */
2280 tem = Fassq (tail, *seen);
2281 if (CONSP (tem) && !NILP (Fequal (XCONS (tem)->car, keys)))
2282 break;
2283 *seen = Fcons (Fcons (tail, keys), *seen);
2284 }
2285 }
2286
2287 UNGCPRO;
2288 }
2289
2290 static int
2291 describe_vector_princ (elt)
2292 Lisp_Object elt;
2293 {
2294 Findent_to (make_number (16), make_number (1));
2295 Fprinc (elt, Qnil);
2296 Fterpri (Qnil);
2297 }
2298
2299 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2300 "Insert a description of contents of VECTOR.\n\
2301 This is text showing the elements of vector matched against indices.")
2302 (vector)
2303 Lisp_Object vector;
2304 {
2305 int count = specpdl_ptr - specpdl;
2306
2307 specbind (Qstandard_output, Fcurrent_buffer ());
2308 CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
2309 describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil, Qnil);
2310
2311 return unbind_to (count, Qnil);
2312 }
2313
2314 /* Insert in the current buffer a description of the contents of VECTOR.
2315 We call ELT_DESCRIBER to insert the description of one value found
2316 in VECTOR.
2317
2318 ELT_PREFIX describes what "comes before" the keys or indices defined
2319 by this vector.
2320
2321 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2322 leads to this keymap.
2323
2324 If the vector is a chartable, ELT_PREFIX is the vector
2325 of bytes that lead to the character set or portion of a character
2326 set described by this chartable.
2327
2328 If PARTIAL is nonzero, it means do not mention suppressed commands
2329 (that assumes the vector is in a keymap).
2330
2331 SHADOW is a list of keymaps that shadow this map.
2332 If it is non-nil, then we look up the key in those maps
2333 and we don't mention it now if it is defined by any of them.
2334
2335 ENTIRE_MAP is the keymap in which this vector appears.
2336 If the definition in effect in the whole map does not match
2337 the one in this vector, we ignore this one. */
2338
2339 describe_vector (vector, elt_prefix, elt_describer,
2340 partial, shadow, entire_map)
2341 register Lisp_Object vector;
2342 Lisp_Object elt_prefix;
2343 int (*elt_describer) ();
2344 int partial;
2345 Lisp_Object shadow;
2346 Lisp_Object entire_map;
2347 {
2348 Lisp_Object this;
2349 Lisp_Object dummy;
2350 Lisp_Object definition;
2351 Lisp_Object tem2;
2352 register int i;
2353 Lisp_Object suppress;
2354 Lisp_Object kludge;
2355 Lisp_Object chartable_kludge;
2356 int first = 1;
2357 int size;
2358 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2359
2360 definition = Qnil;
2361 chartable_kludge = Qnil;
2362
2363 /* This vector gets used to present single keys to Flookup_key. Since
2364 that is done once per vector element, we don't want to cons up a
2365 fresh vector every time. */
2366 kludge = Fmake_vector (make_number (1), Qnil);
2367 GCPRO4 (elt_prefix, definition, kludge, chartable_kludge);
2368
2369 if (partial)
2370 suppress = intern ("suppress-keymap");
2371
2372 /* This does the right thing for char-tables as well as ordinary vectors. */
2373 size = XFASTINT (Flength (vector));
2374
2375 for (i = 0; i < size; i++)
2376 {
2377 QUIT;
2378 definition = get_keyelt (XVECTOR (vector)->contents[i], 0);
2379
2380 if (NILP (definition)) continue;
2381
2382 /* Don't mention suppressed commands. */
2383 if (SYMBOLP (definition) && partial)
2384 {
2385 this = Fget (definition, suppress);
2386 if (!NILP (this))
2387 continue;
2388 }
2389
2390 /* If this binding is shadowed by some other map, ignore it. */
2391 if (!NILP (shadow))
2392 {
2393 Lisp_Object tem;
2394
2395 XVECTOR (kludge)->contents[0] = make_number (i);
2396 tem = shadow_lookup (shadow, kludge, Qt);
2397
2398 if (!NILP (tem)) continue;
2399 }
2400
2401 /* Ignore this definition if it is shadowed by an earlier
2402 one in the same keymap. */
2403 if (!NILP (entire_map))
2404 {
2405 Lisp_Object tem;
2406
2407 XVECTOR (kludge)->contents[0] = make_number (i);
2408 tem = Flookup_key (entire_map, kludge, Qt);
2409
2410 if (! EQ (tem, definition))
2411 continue;
2412 }
2413
2414 /* If we find a char-table within a char-table,
2415 scan it recursively; it defines the details for
2416 a character set or a portion of a character set. */
2417 if (CHAR_TABLE_P (vector) && CHAR_TABLE_P (definition))
2418 {
2419 int outer_level
2420 = !NILP (elt_prefix) ? XVECTOR (elt_prefix)->size : 0;
2421 if (NILP (chartable_kludge))
2422 {
2423 chartable_kludge
2424 = Fmake_vector (make_number (outer_level + 1), Qnil);
2425 if (outer_level != 0)
2426 bcopy (XVECTOR (elt_prefix)->contents,
2427 XVECTOR (chartable_kludge)->contents,
2428 outer_level * sizeof (Lisp_Object));
2429 }
2430 XVECTOR (chartable_kludge)->contents[outer_level]
2431 = make_number (i);
2432 describe_vector (definition, chartable_kludge, elt_describer,
2433 partial, shadow, entire_map);
2434 continue;
2435 }
2436
2437 if (first)
2438 {
2439 insert ("\n", 1);
2440 first = 0;
2441 }
2442
2443 if (CHAR_TABLE_P (vector))
2444 {
2445 if (!NILP (elt_prefix))
2446 {
2447 /* Must combine elt_prefix with i to produce a character
2448 code, then insert that character's description. */
2449 }
2450 else
2451 {
2452 /* Get the string to describe the character I, and print it. */
2453 XSETFASTINT (dummy, i);
2454
2455 /* THIS gets the string to describe the character DUMMY. */
2456 this = Fsingle_key_description (dummy);
2457 insert1 (this);
2458 }
2459 }
2460 else
2461 {
2462 /* Output the prefix that applies to every entry in this map. */
2463 if (!NILP (elt_prefix))
2464 insert1 (elt_prefix);
2465
2466 /* Get the string to describe the character I, and print it. */
2467 XSETFASTINT (dummy, i);
2468
2469 /* THIS gets the string to describe the character DUMMY. */
2470 this = Fsingle_key_description (dummy);
2471 insert1 (this);
2472 }
2473
2474 /* Find all consecutive characters that have the same definition. */
2475 while (i + 1 < XVECTOR (vector)->size
2476 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1], 0),
2477 EQ (tem2, definition)))
2478 i++;
2479
2480 /* If we have a range of more than one character,
2481 print where the range reaches to. */
2482
2483 if (i != XINT (dummy))
2484 {
2485 insert (" .. ", 4);
2486 if (CHAR_TABLE_P (vector))
2487 {
2488 if (!NILP (elt_prefix))
2489 {
2490 /* Must combine elt_prefix with i to produce a character
2491 code, then insert that character's description. */
2492 }
2493 else
2494 {
2495 XSETFASTINT (dummy, i);
2496
2497 this = Fsingle_key_description (dummy);
2498 insert1 (this);
2499 }
2500 }
2501 else
2502 {
2503 if (!NILP (elt_prefix))
2504 insert1 (elt_prefix);
2505
2506 XSETFASTINT (dummy, i);
2507 insert1 (Fsingle_key_description (dummy));
2508 }
2509 }
2510
2511 /* Print a description of the definition of this character.
2512 elt_describer will take care of spacing out far enough
2513 for alignment purposes. */
2514 (*elt_describer) (definition);
2515 }
2516
2517 UNGCPRO;
2518 }
2519 \f
2520 /* Apropos - finding all symbols whose names match a regexp. */
2521 Lisp_Object apropos_predicate;
2522 Lisp_Object apropos_accumulate;
2523
2524 static void
2525 apropos_accum (symbol, string)
2526 Lisp_Object symbol, string;
2527 {
2528 register Lisp_Object tem;
2529
2530 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
2531 if (!NILP (tem) && !NILP (apropos_predicate))
2532 tem = call1 (apropos_predicate, symbol);
2533 if (!NILP (tem))
2534 apropos_accumulate = Fcons (symbol, apropos_accumulate);
2535 }
2536
2537 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
2538 "Show all symbols whose names contain match for REGEXP.\n\
2539 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
2540 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
2541 Return list of symbols found.")
2542 (regexp, predicate)
2543 Lisp_Object regexp, predicate;
2544 {
2545 struct gcpro gcpro1, gcpro2;
2546 CHECK_STRING (regexp, 0);
2547 apropos_predicate = predicate;
2548 GCPRO2 (apropos_predicate, apropos_accumulate);
2549 apropos_accumulate = Qnil;
2550 map_obarray (Vobarray, apropos_accum, regexp);
2551 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
2552 UNGCPRO;
2553 return apropos_accumulate;
2554 }
2555 \f
2556 syms_of_keymap ()
2557 {
2558 Lisp_Object tem;
2559
2560 Qkeymap = intern ("keymap");
2561 staticpro (&Qkeymap);
2562
2563 /* Initialize the keymaps standardly used.
2564 Each one is the value of a Lisp variable, and is also
2565 pointed to by a C variable */
2566
2567 global_map = Fcons (Qkeymap,
2568 Fcons (Fmake_vector (make_number (0400), Qnil), Qnil));
2569 Fset (intern ("global-map"), global_map);
2570
2571 meta_map = Fmake_keymap (Qnil);
2572 Fset (intern ("esc-map"), meta_map);
2573 Ffset (intern ("ESC-prefix"), meta_map);
2574
2575 control_x_map = Fmake_keymap (Qnil);
2576 Fset (intern ("ctl-x-map"), control_x_map);
2577 Ffset (intern ("Control-X-prefix"), control_x_map);
2578
2579 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
2580 "List of commands given new key bindings recently.\n\
2581 This is used for internal purposes during Emacs startup;\n\
2582 don't alter it yourself.");
2583 Vdefine_key_rebound_commands = Qt;
2584
2585 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
2586 "Default keymap to use when reading from the minibuffer.");
2587 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
2588
2589 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
2590 "Local keymap for the minibuffer when spaces are not allowed.");
2591 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
2592
2593 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
2594 "Local keymap for minibuffer input with completion.");
2595 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
2596
2597 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
2598 "Local keymap for minibuffer input with completion, for exact match.");
2599 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
2600
2601 current_global_map = global_map;
2602
2603 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
2604 "Alist of keymaps to use for minor modes.\n\
2605 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
2606 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
2607 If two active keymaps bind the same key, the keymap appearing earlier\n\
2608 in the list takes precedence.");
2609 Vminor_mode_map_alist = Qnil;
2610
2611 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
2612 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
2613 This allows Emacs to recognize function keys sent from ASCII\n\
2614 terminals at any point in a key sequence.\n\
2615 \n\
2616 The `read-key-sequence' function replaces any subsequence bound by\n\
2617 `function-key-map' with its binding. More precisely, when the active\n\
2618 keymaps have no binding for the current key sequence but\n\
2619 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
2620 `read-key-sequence' replaces the matching suffix with its binding, and\n\
2621 continues with the new sequence.\n\
2622 \n\
2623 The events that come from bindings in `function-key-map' are not\n\
2624 themselves looked up in `function-key-map'.\n\
2625 \n\
2626 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
2627 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
2628 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
2629 key, typing `ESC O P x' would return [f1 x].");
2630 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
2631
2632 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
2633 "Keymap of key translations that can override keymaps.\n\
2634 This keymap works like `function-key-map', but comes after that,\n\
2635 and applies even for keys that have ordinary bindings.");
2636 Vkey_translation_map = Qnil;
2637
2638 Qsingle_key_description = intern ("single-key-description");
2639 staticpro (&Qsingle_key_description);
2640
2641 Qkey_description = intern ("key-description");
2642 staticpro (&Qkey_description);
2643
2644 Qkeymapp = intern ("keymapp");
2645 staticpro (&Qkeymapp);
2646
2647 Qnon_ascii = intern ("non-ascii");
2648 staticpro (&Qnon_ascii);
2649
2650 defsubr (&Skeymapp);
2651 defsubr (&Smake_keymap);
2652 defsubr (&Smake_sparse_keymap);
2653 defsubr (&Scopy_keymap);
2654 defsubr (&Skey_binding);
2655 defsubr (&Slocal_key_binding);
2656 defsubr (&Sglobal_key_binding);
2657 defsubr (&Sminor_mode_key_binding);
2658 defsubr (&Sdefine_key);
2659 defsubr (&Slookup_key);
2660 defsubr (&Sdefine_prefix_command);
2661 defsubr (&Suse_global_map);
2662 defsubr (&Suse_local_map);
2663 defsubr (&Scurrent_local_map);
2664 defsubr (&Scurrent_global_map);
2665 defsubr (&Scurrent_minor_mode_maps);
2666 defsubr (&Saccessible_keymaps);
2667 defsubr (&Skey_description);
2668 defsubr (&Sdescribe_vector);
2669 defsubr (&Ssingle_key_description);
2670 defsubr (&Stext_char_description);
2671 defsubr (&Swhere_is_internal);
2672 defsubr (&Sdescribe_bindings);
2673 defsubr (&Sapropos_internal);
2674 }
2675
2676 keys_of_keymap ()
2677 {
2678 Lisp_Object tem;
2679
2680 initial_define_key (global_map, 033, "ESC-prefix");
2681 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
2682 }