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