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