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