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