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