Merge from emacs--rel--22
[bpt/emacs.git] / src / keymap.c
1 /* Manipulation of keymaps
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
11 any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
22
23
24 #include <config.h>
25 #include <stdio.h>
26 #if HAVE_ALLOCA_H
27 # include <alloca.h>
28 #endif
29 #include "lisp.h"
30 #include "commands.h"
31 #include "buffer.h"
32 #include "charset.h"
33 #include "keyboard.h"
34 #include "termhooks.h"
35 #include "blockinput.h"
36 #include "puresize.h"
37 #include "intervals.h"
38 #include "keymap.h"
39 #include "window.h"
40
41 /* The number of elements in keymap vectors. */
42 #define DENSE_TABLE_SIZE (0200)
43
44 /* Actually allocate storage for these variables */
45
46 Lisp_Object current_global_map; /* Current global keymap */
47
48 Lisp_Object global_map; /* default global key bindings */
49
50 Lisp_Object meta_map; /* The keymap used for globally bound
51 ESC-prefixed default commands */
52
53 Lisp_Object control_x_map; /* The keymap used for globally bound
54 C-x-prefixed default commands */
55
56 /* was MinibufLocalMap */
57 Lisp_Object Vminibuffer_local_map;
58 /* The keymap used by the minibuf for local
59 bindings when spaces are allowed in the
60 minibuf */
61
62 /* was MinibufLocalNSMap */
63 Lisp_Object Vminibuffer_local_ns_map;
64 /* The keymap used by the minibuf for local
65 bindings when spaces are not encouraged
66 in the minibuf */
67
68 /* keymap used for minibuffers when doing completion */
69 /* was MinibufLocalCompletionMap */
70 Lisp_Object Vminibuffer_local_completion_map;
71
72 /* keymap used for minibuffers when doing completion in filenames */
73 Lisp_Object Vminibuffer_local_filename_completion_map;
74
75 /* keymap used for minibuffers when doing completion in filenames
76 with require-match*/
77 Lisp_Object Vminibuffer_local_must_match_filename_map;
78
79 /* keymap used for minibuffers when doing completion and require a match */
80 /* was MinibufLocalMustMatchMap */
81 Lisp_Object Vminibuffer_local_must_match_map;
82
83 /* Alist of minor mode variables and keymaps. */
84 Lisp_Object Vminor_mode_map_alist;
85
86 /* Alist of major-mode-specific overrides for
87 minor mode variables and keymaps. */
88 Lisp_Object Vminor_mode_overriding_map_alist;
89
90 /* List of emulation mode keymap alists. */
91 Lisp_Object Vemulation_mode_map_alists;
92
93 /* Keymap mapping ASCII function key sequences onto their preferred forms.
94 Initialized by the terminal-specific lisp files. See DEFVAR for more
95 documentation. */
96 Lisp_Object Vfunction_key_map;
97
98 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
99 Lisp_Object Vkey_translation_map;
100
101 /* A list of all commands given new bindings since a certain time
102 when nil was stored here.
103 This is used to speed up recomputation of menu key equivalents
104 when Emacs starts up. t means don't record anything here. */
105 Lisp_Object Vdefine_key_rebound_commands;
106
107 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
108
109 /* Alist of elements like (DEL . "\d"). */
110 static Lisp_Object exclude_keys;
111
112 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
113 static Lisp_Object command_remapping_vector;
114
115 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
116 in a string key sequence is equivalent to prefixing with this
117 character. */
118 extern Lisp_Object meta_prefix_char;
119
120 extern Lisp_Object Voverriding_local_map;
121
122 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
123 static Lisp_Object where_is_cache;
124 /* Which keymaps are reverse-stored in the cache. */
125 static Lisp_Object where_is_cache_keymaps;
126
127 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
128 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
129
130 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
131 static void describe_command P_ ((Lisp_Object, Lisp_Object));
132 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
133 static void describe_map P_ ((Lisp_Object, Lisp_Object,
134 void (*) P_ ((Lisp_Object, Lisp_Object)),
135 int, Lisp_Object, Lisp_Object*, int, int));
136 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
137 void (*) (Lisp_Object, Lisp_Object), int,
138 Lisp_Object, Lisp_Object, int *,
139 int, int, int));
140 static void silly_event_symbol_error P_ ((Lisp_Object));
141 \f
142 /* Keymap object support - constructors and predicates. */
143
144 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
145 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
146 CHARTABLE is a char-table that holds the bindings for all characters
147 without modifiers. All entries in it are initially nil, meaning
148 "command undefined". ALIST is an assoc-list which holds bindings for
149 function keys, mouse events, and any other things that appear in the
150 input stream. Initially, ALIST is nil.
151
152 The optional arg STRING supplies a menu name for the keymap
153 in case you use it as a menu with `x-popup-menu'. */)
154 (string)
155 Lisp_Object string;
156 {
157 Lisp_Object tail;
158 if (!NILP (string))
159 tail = Fcons (string, Qnil);
160 else
161 tail = Qnil;
162 return Fcons (Qkeymap,
163 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
164 }
165
166 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
167 doc: /* Construct and return a new sparse keymap.
168 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
169 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
170 which binds the function key or mouse event SYMBOL to DEFINITION.
171 Initially the alist is nil.
172
173 The optional arg STRING supplies a menu name for the keymap
174 in case you use it as a menu with `x-popup-menu'. */)
175 (string)
176 Lisp_Object string;
177 {
178 if (!NILP (string))
179 return Fcons (Qkeymap, Fcons (string, Qnil));
180 return Fcons (Qkeymap, Qnil);
181 }
182
183 /* This function is used for installing the standard key bindings
184 at initialization time.
185
186 For example:
187
188 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
189
190 void
191 initial_define_key (keymap, key, defname)
192 Lisp_Object keymap;
193 int key;
194 char *defname;
195 {
196 store_in_keymap (keymap, make_number (key), intern (defname));
197 }
198
199 void
200 initial_define_lispy_key (keymap, keyname, defname)
201 Lisp_Object keymap;
202 char *keyname;
203 char *defname;
204 {
205 store_in_keymap (keymap, intern (keyname), intern (defname));
206 }
207
208 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
209 doc: /* Return t if OBJECT is a keymap.
210
211 A keymap is a list (keymap . ALIST),
212 or a symbol whose function definition is itself a keymap.
213 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
214 a vector of densely packed bindings for small character codes
215 is also allowed as an element. */)
216 (object)
217 Lisp_Object object;
218 {
219 return (KEYMAPP (object) ? Qt : Qnil);
220 }
221
222 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
223 doc: /* Return the prompt-string of a keymap MAP.
224 If non-nil, the prompt is shown in the echo-area
225 when reading a key-sequence to be looked-up in this keymap. */)
226 (map)
227 Lisp_Object map;
228 {
229 map = get_keymap (map, 0, 0);
230 while (CONSP (map))
231 {
232 Lisp_Object tem = XCAR (map);
233 if (STRINGP (tem))
234 return tem;
235 map = XCDR (map);
236 }
237 return Qnil;
238 }
239
240 /* Check that OBJECT is a keymap (after dereferencing through any
241 symbols). If it is, return it.
242
243 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
244 is an autoload form, do the autoload and try again.
245 If AUTOLOAD is nonzero, callers must assume GC is possible.
246
247 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
248 is zero as well), return Qt.
249
250 ERROR controls how we respond if OBJECT isn't a keymap.
251 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
252
253 Note that most of the time, we don't want to pursue autoloads.
254 Functions like Faccessible_keymaps which scan entire keymap trees
255 shouldn't load every autoloaded keymap. I'm not sure about this,
256 but it seems to me that only read_key_sequence, Flookup_key, and
257 Fdefine_key should cause keymaps to be autoloaded.
258
259 This function can GC when AUTOLOAD is non-zero, because it calls
260 do_autoload which can GC. */
261
262 Lisp_Object
263 get_keymap (object, error, autoload)
264 Lisp_Object object;
265 int error, autoload;
266 {
267 Lisp_Object tem;
268
269 autoload_retry:
270 if (NILP (object))
271 goto end;
272 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
273 return object;
274
275 tem = indirect_function (object);
276 if (CONSP (tem))
277 {
278 if (EQ (XCAR (tem), Qkeymap))
279 return tem;
280
281 /* Should we do an autoload? Autoload forms for keymaps have
282 Qkeymap as their fifth element. */
283 if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
284 && SYMBOLP (object))
285 {
286 Lisp_Object tail;
287
288 tail = Fnth (make_number (4), tem);
289 if (EQ (tail, Qkeymap))
290 {
291 if (autoload)
292 {
293 struct gcpro gcpro1, gcpro2;
294
295 GCPRO2 (tem, object);
296 do_autoload (tem, object);
297 UNGCPRO;
298
299 goto autoload_retry;
300 }
301 else
302 return Qt;
303 }
304 }
305 }
306
307 end:
308 if (error)
309 wrong_type_argument (Qkeymapp, object);
310 return Qnil;
311 }
312 \f
313 /* Return the parent map of KEYMAP, or nil if it has none.
314 We assume that KEYMAP is a valid keymap. */
315
316 Lisp_Object
317 keymap_parent (keymap, autoload)
318 Lisp_Object keymap;
319 int autoload;
320 {
321 Lisp_Object list;
322
323 keymap = get_keymap (keymap, 1, autoload);
324
325 /* Skip past the initial element `keymap'. */
326 list = XCDR (keymap);
327 for (; CONSP (list); list = XCDR (list))
328 {
329 /* See if there is another `keymap'. */
330 if (KEYMAPP (list))
331 return list;
332 }
333
334 return get_keymap (list, 0, autoload);
335 }
336
337 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
338 doc: /* Return the parent keymap of KEYMAP. */)
339 (keymap)
340 Lisp_Object keymap;
341 {
342 return keymap_parent (keymap, 1);
343 }
344
345 /* Check whether MAP is one of MAPS parents. */
346 int
347 keymap_memberp (map, maps)
348 Lisp_Object map, maps;
349 {
350 if (NILP (map)) return 0;
351 while (KEYMAPP (maps) && !EQ (map, maps))
352 maps = keymap_parent (maps, 0);
353 return (EQ (map, maps));
354 }
355
356 /* Set the parent keymap of MAP to PARENT. */
357
358 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
359 doc: /* Modify KEYMAP to set its parent map to PARENT.
360 Return PARENT. PARENT should be nil or another keymap. */)
361 (keymap, parent)
362 Lisp_Object keymap, parent;
363 {
364 Lisp_Object list, prev;
365 struct gcpro gcpro1, gcpro2;
366 int i;
367
368 /* Force a keymap flush for the next call to where-is.
369 Since this can be called from within where-is, we don't set where_is_cache
370 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
371 be changed during where-is, while where_is_cache_keymaps is only used at
372 the very beginning of where-is and can thus be changed here without any
373 adverse effect.
374 This is a very minor correctness (rather than safety) issue. */
375 where_is_cache_keymaps = Qt;
376
377 GCPRO2 (keymap, parent);
378 keymap = get_keymap (keymap, 1, 1);
379
380 if (!NILP (parent))
381 {
382 parent = get_keymap (parent, 1, 1);
383
384 /* Check for cycles. */
385 if (keymap_memberp (keymap, parent))
386 error ("Cyclic keymap inheritance");
387 }
388
389 /* Skip past the initial element `keymap'. */
390 prev = keymap;
391 while (1)
392 {
393 list = XCDR (prev);
394 /* If there is a parent keymap here, replace it.
395 If we came to the end, add the parent in PREV. */
396 if (!CONSP (list) || KEYMAPP (list))
397 {
398 /* If we already have the right parent, return now
399 so that we avoid the loops below. */
400 if (EQ (XCDR (prev), parent))
401 RETURN_UNGCPRO (parent);
402
403 CHECK_IMPURE (prev);
404 XSETCDR (prev, parent);
405 break;
406 }
407 prev = list;
408 }
409
410 /* Scan through for submaps, and set their parents too. */
411
412 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
413 {
414 /* Stop the scan when we come to the parent. */
415 if (EQ (XCAR (list), Qkeymap))
416 break;
417
418 /* If this element holds a prefix map, deal with it. */
419 if (CONSP (XCAR (list))
420 && CONSP (XCDR (XCAR (list))))
421 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
422 XCDR (XCAR (list)));
423
424 if (VECTORP (XCAR (list)))
425 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
426 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
427 fix_submap_inheritance (keymap, make_number (i),
428 XVECTOR (XCAR (list))->contents[i]);
429
430 if (CHAR_TABLE_P (XCAR (list)))
431 {
432 Lisp_Object indices[3];
433
434 map_char_table (fix_submap_inheritance, Qnil,
435 XCAR (list), XCAR (list),
436 keymap, 0, indices);
437 }
438 }
439
440 RETURN_UNGCPRO (parent);
441 }
442
443 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
444 if EVENT is also a prefix in MAP's parent,
445 make sure that SUBMAP inherits that definition as its own parent. */
446
447 static void
448 fix_submap_inheritance (map, event, submap)
449 Lisp_Object map, event, submap;
450 {
451 Lisp_Object map_parent, parent_entry;
452
453 /* SUBMAP is a cons that we found as a key binding.
454 Discard the other things found in a menu key binding. */
455
456 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
457
458 /* If it isn't a keymap now, there's no work to do. */
459 if (!CONSP (submap))
460 return;
461
462 map_parent = keymap_parent (map, 0);
463 if (!NILP (map_parent))
464 parent_entry =
465 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
466 else
467 parent_entry = Qnil;
468
469 /* If MAP's parent has something other than a keymap,
470 our own submap shadows it completely. */
471 if (!CONSP (parent_entry))
472 return;
473
474 if (! EQ (parent_entry, submap))
475 {
476 Lisp_Object submap_parent;
477 submap_parent = submap;
478 while (1)
479 {
480 Lisp_Object tem;
481
482 tem = keymap_parent (submap_parent, 0);
483
484 if (KEYMAPP (tem))
485 {
486 if (keymap_memberp (tem, parent_entry))
487 /* Fset_keymap_parent could create a cycle. */
488 return;
489 submap_parent = tem;
490 }
491 else
492 break;
493 }
494 Fset_keymap_parent (submap_parent, parent_entry);
495 }
496 }
497 \f
498 /* Look up IDX in MAP. IDX may be any sort of event.
499 Note that this does only one level of lookup; IDX must be a single
500 event, not a sequence.
501
502 If T_OK is non-zero, bindings for Qt are treated as default
503 bindings; any key left unmentioned by other tables and bindings is
504 given the binding of Qt.
505
506 If T_OK is zero, bindings for Qt are not treated specially.
507
508 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
509
510 Lisp_Object
511 access_keymap (map, idx, t_ok, noinherit, autoload)
512 Lisp_Object map;
513 Lisp_Object idx;
514 int t_ok;
515 int noinherit;
516 int autoload;
517 {
518 Lisp_Object val;
519
520 /* Qunbound in VAL means we have found no binding yet. */
521 val = Qunbound;
522
523 /* If idx is a list (some sort of mouse click, perhaps?),
524 the index we want to use is the car of the list, which
525 ought to be a symbol. */
526 idx = EVENT_HEAD (idx);
527
528 /* If idx is a symbol, it might have modifiers, which need to
529 be put in the canonical order. */
530 if (SYMBOLP (idx))
531 idx = reorder_modifiers (idx);
532 else if (INTEGERP (idx))
533 /* Clobber the high bits that can be present on a machine
534 with more than 24 bits of integer. */
535 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
536
537 /* Handle the special meta -> esc mapping. */
538 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
539 {
540 /* See if there is a meta-map. If there's none, there is
541 no binding for IDX, unless a default binding exists in MAP. */
542 struct gcpro gcpro1;
543 Lisp_Object meta_map;
544 GCPRO1 (map);
545 /* A strange value in which Meta is set would cause
546 infinite recursion. Protect against that. */
547 if (XINT (meta_prefix_char) & CHAR_META)
548 meta_prefix_char = make_number (27);
549 meta_map = get_keymap (access_keymap (map, meta_prefix_char,
550 t_ok, noinherit, autoload),
551 0, autoload);
552 UNGCPRO;
553 if (CONSP (meta_map))
554 {
555 map = meta_map;
556 idx = make_number (XUINT (idx) & ~meta_modifier);
557 }
558 else if (t_ok)
559 /* Set IDX to t, so that we only find a default binding. */
560 idx = Qt;
561 else
562 /* We know there is no binding. */
563 return Qnil;
564 }
565
566 /* t_binding is where we put a default binding that applies,
567 to use in case we do not find a binding specifically
568 for this key sequence. */
569 {
570 Lisp_Object tail;
571 Lisp_Object t_binding = Qnil;
572 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
573
574 GCPRO4 (map, tail, idx, t_binding);
575
576 /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
577 If it is 1, only generic-char bindings are accepted.
578 Otherwise, neither are. */
579 t_ok = t_ok ? 2 : 0;
580
581 for (tail = XCDR (map);
582 (CONSP (tail)
583 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
584 tail = XCDR (tail))
585 {
586 Lisp_Object binding;
587
588 binding = XCAR (tail);
589 if (SYMBOLP (binding))
590 {
591 /* If NOINHERIT, stop finding prefix definitions
592 after we pass a second occurrence of the `keymap' symbol. */
593 if (noinherit && EQ (binding, Qkeymap))
594 RETURN_UNGCPRO (Qnil);
595 }
596 else if (CONSP (binding))
597 {
598 Lisp_Object key = XCAR (binding);
599
600 if (EQ (key, idx))
601 val = XCDR (binding);
602 else if (t_ok
603 && INTEGERP (idx)
604 && (XINT (idx) & CHAR_MODIFIER_MASK) == 0
605 && INTEGERP (key)
606 && (XINT (key) & CHAR_MODIFIER_MASK) == 0
607 && !SINGLE_BYTE_CHAR_P (XINT (idx))
608 && !SINGLE_BYTE_CHAR_P (XINT (key))
609 && CHAR_VALID_P (XINT (key), 1)
610 && !CHAR_VALID_P (XINT (key), 0)
611 && (CHAR_CHARSET (XINT (key))
612 == CHAR_CHARSET (XINT (idx))))
613 {
614 /* KEY is the generic character of the charset of IDX.
615 Use KEY's binding if there isn't a binding for IDX
616 itself. */
617 t_binding = XCDR (binding);
618 t_ok = 0;
619 }
620 else if (t_ok > 1 && EQ (key, Qt))
621 {
622 t_binding = XCDR (binding);
623 t_ok = 1;
624 }
625 }
626 else if (VECTORP (binding))
627 {
628 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
629 val = AREF (binding, XFASTINT (idx));
630 }
631 else if (CHAR_TABLE_P (binding))
632 {
633 /* Character codes with modifiers
634 are not included in a char-table.
635 All character codes without modifiers are included. */
636 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
637 {
638 val = Faref (binding, idx);
639 /* `nil' has a special meaning for char-tables, so
640 we use something else to record an explicitly
641 unbound entry. */
642 if (NILP (val))
643 val = Qunbound;
644 }
645 }
646
647 /* If we found a binding, clean it up and return it. */
648 if (!EQ (val, Qunbound))
649 {
650 if (EQ (val, Qt))
651 /* A Qt binding is just like an explicit nil binding
652 (i.e. it shadows any parent binding but not bindings in
653 keymaps of lower precedence). */
654 val = Qnil;
655 val = get_keyelt (val, autoload);
656 if (KEYMAPP (val))
657 fix_submap_inheritance (map, idx, val);
658 RETURN_UNGCPRO (val);
659 }
660 QUIT;
661 }
662 UNGCPRO;
663 return get_keyelt (t_binding, autoload);
664 }
665 }
666
667 static void
668 map_keymap_item (fun, args, key, val, data)
669 map_keymap_function_t fun;
670 Lisp_Object args, key, val;
671 void *data;
672 {
673 /* We should maybe try to detect bindings shadowed by previous
674 ones and things like that. */
675 if (EQ (val, Qt))
676 val = Qnil;
677 (*fun) (key, val, args, data);
678 }
679
680 static void
681 map_keymap_char_table_item (args, key, val)
682 Lisp_Object args, key, val;
683 {
684 if (!NILP (val))
685 {
686 map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
687 args = XCDR (args);
688 map_keymap_item (fun, XCDR (args), key, val,
689 XSAVE_VALUE (XCAR (args))->pointer);
690 }
691 }
692
693 /* Call FUN for every binding in MAP.
694 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
695 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
696 void
697 map_keymap (map, fun, args, data, autoload)
698 map_keymap_function_t fun;
699 Lisp_Object map, args;
700 void *data;
701 int autoload;
702 {
703 struct gcpro gcpro1, gcpro2, gcpro3;
704 Lisp_Object tail;
705
706 tail = Qnil;
707 GCPRO3 (map, args, tail);
708 map = get_keymap (map, 1, autoload);
709 for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
710 CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
711 tail = XCDR (tail))
712 {
713 Lisp_Object binding = XCAR (tail);
714
715 if (CONSP (binding))
716 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
717 else if (VECTORP (binding))
718 {
719 /* Loop over the char values represented in the vector. */
720 int len = ASIZE (binding);
721 int c;
722 for (c = 0; c < len; c++)
723 {
724 Lisp_Object character;
725 XSETFASTINT (character, c);
726 map_keymap_item (fun, args, character, AREF (binding, c), data);
727 }
728 }
729 else if (CHAR_TABLE_P (binding))
730 {
731 Lisp_Object indices[3];
732 map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
733 Fcons (make_save_value (fun, 0),
734 Fcons (make_save_value (data, 0),
735 args)),
736 0, indices);
737 }
738 }
739 UNGCPRO;
740 }
741
742 static void
743 map_keymap_call (key, val, fun, dummy)
744 Lisp_Object key, val, fun;
745 void *dummy;
746 {
747 call2 (fun, key, val);
748 }
749
750 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
751 doc: /* Call FUNCTION once for each event binding in KEYMAP.
752 FUNCTION is called with two arguments: the event that is bound, and
753 the definition it is bound to. If the event is an integer, it may be
754 a generic character (see Info node `(elisp)Splitting Characters'), and
755 that means that all actual character events belonging to that generic
756 character are bound to the definition.
757
758 If KEYMAP has a parent, the parent's bindings are included as well.
759 This works recursively: if the parent has itself a parent, then the
760 grandparent's bindings are also included and so on.
761 usage: (map-keymap FUNCTION KEYMAP) */)
762 (function, keymap, sort_first)
763 Lisp_Object function, keymap, sort_first;
764 {
765 if (INTEGERP (function))
766 /* We have to stop integers early since map_keymap gives them special
767 significance. */
768 xsignal1 (Qinvalid_function, function);
769 if (! NILP (sort_first))
770 return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
771
772 map_keymap (keymap, map_keymap_call, function, NULL, 1);
773 return Qnil;
774 }
775
776 /* Given OBJECT which was found in a slot in a keymap,
777 trace indirect definitions to get the actual definition of that slot.
778 An indirect definition is a list of the form
779 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
780 and INDEX is the object to look up in KEYMAP to yield the definition.
781
782 Also if OBJECT has a menu string as the first element,
783 remove that. Also remove a menu help string as second element.
784
785 If AUTOLOAD is nonzero, load autoloadable keymaps
786 that are referred to with indirection.
787
788 This can GC because menu_item_eval_property calls Feval. */
789
790 Lisp_Object
791 get_keyelt (object, autoload)
792 Lisp_Object object;
793 int autoload;
794 {
795 while (1)
796 {
797 if (!(CONSP (object)))
798 /* This is really the value. */
799 return object;
800
801 /* If the keymap contents looks like (keymap ...) or (lambda ...)
802 then use itself. */
803 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
804 return object;
805
806 /* If the keymap contents looks like (menu-item name . DEFN)
807 or (menu-item name DEFN ...) then use DEFN.
808 This is a new format menu item. */
809 else if (EQ (XCAR (object), Qmenu_item))
810 {
811 if (CONSP (XCDR (object)))
812 {
813 Lisp_Object tem;
814
815 object = XCDR (XCDR (object));
816 tem = object;
817 if (CONSP (object))
818 object = XCAR (object);
819
820 /* If there's a `:filter FILTER', apply FILTER to the
821 menu-item's definition to get the real definition to
822 use. */
823 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
824 if (EQ (XCAR (tem), QCfilter) && autoload)
825 {
826 Lisp_Object filter;
827 filter = XCAR (XCDR (tem));
828 filter = list2 (filter, list2 (Qquote, object));
829 object = menu_item_eval_property (filter);
830 break;
831 }
832 }
833 else
834 /* Invalid keymap. */
835 return object;
836 }
837
838 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
839 Keymap alist elements like (CHAR MENUSTRING . DEFN)
840 will be used by HierarKey menus. */
841 else if (STRINGP (XCAR (object)))
842 {
843 object = XCDR (object);
844 /* Also remove a menu help string, if any,
845 following the menu item name. */
846 if (CONSP (object) && STRINGP (XCAR (object)))
847 object = XCDR (object);
848 /* Also remove the sublist that caches key equivalences, if any. */
849 if (CONSP (object) && CONSP (XCAR (object)))
850 {
851 Lisp_Object carcar;
852 carcar = XCAR (XCAR (object));
853 if (NILP (carcar) || VECTORP (carcar))
854 object = XCDR (object);
855 }
856 }
857
858 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
859 else
860 {
861 struct gcpro gcpro1;
862 Lisp_Object map;
863 GCPRO1 (object);
864 map = get_keymap (Fcar_safe (object), 0, autoload);
865 UNGCPRO;
866 return (!CONSP (map) ? object /* Invalid keymap */
867 : access_keymap (map, Fcdr (object), 0, 0, autoload));
868 }
869 }
870 }
871
872 static Lisp_Object
873 store_in_keymap (keymap, idx, def)
874 Lisp_Object keymap;
875 register Lisp_Object idx;
876 Lisp_Object def;
877 {
878 /* Flush any reverse-map cache. */
879 where_is_cache = Qnil;
880 where_is_cache_keymaps = Qt;
881
882 /* If we are preparing to dump, and DEF is a menu element
883 with a menu item indicator, copy it to ensure it is not pure. */
884 if (CONSP (def) && PURE_P (def)
885 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
886 def = Fcons (XCAR (def), XCDR (def));
887
888 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
889 error ("attempt to define a key in a non-keymap");
890
891 /* If idx is a list (some sort of mouse click, perhaps?),
892 the index we want to use is the car of the list, which
893 ought to be a symbol. */
894 idx = EVENT_HEAD (idx);
895
896 /* If idx is a symbol, it might have modifiers, which need to
897 be put in the canonical order. */
898 if (SYMBOLP (idx))
899 idx = reorder_modifiers (idx);
900 else if (INTEGERP (idx))
901 /* Clobber the high bits that can be present on a machine
902 with more than 24 bits of integer. */
903 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
904
905 /* Scan the keymap for a binding of idx. */
906 {
907 Lisp_Object tail;
908
909 /* The cons after which we should insert new bindings. If the
910 keymap has a table element, we record its position here, so new
911 bindings will go after it; this way, the table will stay
912 towards the front of the alist and character lookups in dense
913 keymaps will remain fast. Otherwise, this just points at the
914 front of the keymap. */
915 Lisp_Object insertion_point;
916
917 insertion_point = keymap;
918 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
919 {
920 Lisp_Object elt;
921
922 elt = XCAR (tail);
923 if (VECTORP (elt))
924 {
925 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
926 {
927 CHECK_IMPURE (elt);
928 ASET (elt, XFASTINT (idx), def);
929 return def;
930 }
931 insertion_point = tail;
932 }
933 else if (CHAR_TABLE_P (elt))
934 {
935 /* Character codes with modifiers
936 are not included in a char-table.
937 All character codes without modifiers are included. */
938 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
939 {
940 Faset (elt, idx,
941 /* `nil' has a special meaning for char-tables, so
942 we use something else to record an explicitly
943 unbound entry. */
944 NILP (def) ? Qt : def);
945 return def;
946 }
947 insertion_point = tail;
948 }
949 else if (CONSP (elt))
950 {
951 if (EQ (idx, XCAR (elt)))
952 {
953 CHECK_IMPURE (elt);
954 XSETCDR (elt, def);
955 return def;
956 }
957 }
958 else if (EQ (elt, Qkeymap))
959 /* If we find a 'keymap' symbol in the spine of KEYMAP,
960 then we must have found the start of a second keymap
961 being used as the tail of KEYMAP, and a binding for IDX
962 should be inserted before it. */
963 goto keymap_end;
964
965 QUIT;
966 }
967
968 keymap_end:
969 /* We have scanned the entire keymap, and not found a binding for
970 IDX. Let's add one. */
971 CHECK_IMPURE (insertion_point);
972 XSETCDR (insertion_point,
973 Fcons (Fcons (idx, def), XCDR (insertion_point)));
974 }
975
976 return def;
977 }
978
979 EXFUN (Fcopy_keymap, 1);
980
981 Lisp_Object
982 copy_keymap_item (elt)
983 Lisp_Object elt;
984 {
985 Lisp_Object res, tem;
986
987 if (!CONSP (elt))
988 return elt;
989
990 res = tem = elt;
991
992 /* Is this a new format menu item. */
993 if (EQ (XCAR (tem), Qmenu_item))
994 {
995 /* Copy cell with menu-item marker. */
996 res = elt = Fcons (XCAR (tem), XCDR (tem));
997 tem = XCDR (elt);
998 if (CONSP (tem))
999 {
1000 /* Copy cell with menu-item name. */
1001 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1002 elt = XCDR (elt);
1003 tem = XCDR (elt);
1004 }
1005 if (CONSP (tem))
1006 {
1007 /* Copy cell with binding and if the binding is a keymap,
1008 copy that. */
1009 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1010 elt = XCDR (elt);
1011 tem = XCAR (elt);
1012 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1013 XSETCAR (elt, Fcopy_keymap (tem));
1014 tem = XCDR (elt);
1015 if (CONSP (tem) && CONSP (XCAR (tem)))
1016 /* Delete cache for key equivalences. */
1017 XSETCDR (elt, XCDR (tem));
1018 }
1019 }
1020 else
1021 {
1022 /* It may be an old fomat menu item.
1023 Skip the optional menu string. */
1024 if (STRINGP (XCAR (tem)))
1025 {
1026 /* Copy the cell, since copy-alist didn't go this deep. */
1027 res = elt = Fcons (XCAR (tem), XCDR (tem));
1028 tem = XCDR (elt);
1029 /* Also skip the optional menu help string. */
1030 if (CONSP (tem) && STRINGP (XCAR (tem)))
1031 {
1032 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1033 elt = XCDR (elt);
1034 tem = XCDR (elt);
1035 }
1036 /* There may also be a list that caches key equivalences.
1037 Just delete it for the new keymap. */
1038 if (CONSP (tem)
1039 && CONSP (XCAR (tem))
1040 && (NILP (XCAR (XCAR (tem)))
1041 || VECTORP (XCAR (XCAR (tem)))))
1042 {
1043 XSETCDR (elt, XCDR (tem));
1044 tem = XCDR (tem);
1045 }
1046 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1047 XSETCDR (elt, Fcopy_keymap (tem));
1048 }
1049 else if (EQ (XCAR (tem), Qkeymap))
1050 res = Fcopy_keymap (elt);
1051 }
1052 return res;
1053 }
1054
1055 static void
1056 copy_keymap_1 (chartable, idx, elt)
1057 Lisp_Object chartable, idx, elt;
1058 {
1059 Faset (chartable, idx, copy_keymap_item (elt));
1060 }
1061
1062 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1063 doc: /* Return a copy of the keymap KEYMAP.
1064 The copy starts out with the same definitions of KEYMAP,
1065 but changing either the copy or KEYMAP does not affect the other.
1066 Any key definitions that are subkeymaps are recursively copied.
1067 However, a key definition which is a symbol whose definition is a keymap
1068 is not copied. */)
1069 (keymap)
1070 Lisp_Object keymap;
1071 {
1072 register Lisp_Object copy, tail;
1073 keymap = get_keymap (keymap, 1, 0);
1074 copy = tail = Fcons (Qkeymap, Qnil);
1075 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1076
1077 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1078 {
1079 Lisp_Object elt = XCAR (keymap);
1080 if (CHAR_TABLE_P (elt))
1081 {
1082 Lisp_Object indices[3];
1083 elt = Fcopy_sequence (elt);
1084 map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
1085 }
1086 else if (VECTORP (elt))
1087 {
1088 int i;
1089 elt = Fcopy_sequence (elt);
1090 for (i = 0; i < ASIZE (elt); i++)
1091 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1092 }
1093 else if (CONSP (elt))
1094 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1095 XSETCDR (tail, Fcons (elt, Qnil));
1096 tail = XCDR (tail);
1097 keymap = XCDR (keymap);
1098 }
1099 XSETCDR (tail, keymap);
1100 return copy;
1101 }
1102 \f
1103 /* Simple Keymap mutators and accessors. */
1104
1105 /* GC is possible in this function if it autoloads a keymap. */
1106
1107 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1108 doc: /* In KEYMAP, define key sequence KEY as DEF.
1109 KEYMAP is a keymap.
1110
1111 KEY is a string or a vector of symbols and characters meaning a
1112 sequence of keystrokes and events. Non-ASCII characters with codes
1113 above 127 (such as ISO Latin-1) can be included if you use a vector.
1114 Using [t] for KEY creates a default definition, which applies to any
1115 event type that has no other definition in this keymap.
1116
1117 DEF is anything that can be a key's definition:
1118 nil (means key is undefined in this keymap),
1119 a command (a Lisp function suitable for interactive calling),
1120 a string (treated as a keyboard macro),
1121 a keymap (to define a prefix key),
1122 a symbol (when the key is looked up, the symbol will stand for its
1123 function definition, which should at that time be one of the above,
1124 or another symbol whose function definition is used, etc.),
1125 a cons (STRING . DEFN), meaning that DEFN is the definition
1126 (DEFN should be a valid definition in its own right),
1127 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1128 or an extended menu item definition.
1129 (See info node `(elisp)Extended Menu Items'.)
1130
1131 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1132 binding is altered. If there is no binding for KEY, the new pair
1133 binding KEY to DEF is added at the front of KEYMAP. */)
1134 (keymap, key, def)
1135 Lisp_Object keymap;
1136 Lisp_Object key;
1137 Lisp_Object def;
1138 {
1139 register int idx;
1140 register Lisp_Object c;
1141 register Lisp_Object cmd;
1142 int metized = 0;
1143 int meta_bit;
1144 int length;
1145 struct gcpro gcpro1, gcpro2, gcpro3;
1146
1147 GCPRO3 (keymap, key, def);
1148 keymap = get_keymap (keymap, 1, 1);
1149
1150 CHECK_VECTOR_OR_STRING (key);
1151
1152 length = XFASTINT (Flength (key));
1153 if (length == 0)
1154 RETURN_UNGCPRO (Qnil);
1155
1156 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1157 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1158
1159 meta_bit = (VECTORP (key) || STRINGP (key) && STRING_MULTIBYTE (key)
1160 ? meta_modifier : 0x80);
1161
1162 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1163 { /* DEF is apparently an XEmacs-style keyboard macro. */
1164 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1165 int i = ASIZE (def);
1166 while (--i >= 0)
1167 {
1168 Lisp_Object c = AREF (def, i);
1169 if (CONSP (c) && lucid_event_type_list_p (c))
1170 c = Fevent_convert_list (c);
1171 ASET (tmp, i, c);
1172 }
1173 def = tmp;
1174 }
1175
1176 idx = 0;
1177 while (1)
1178 {
1179 c = Faref (key, make_number (idx));
1180
1181 if (CONSP (c) && lucid_event_type_list_p (c))
1182 c = Fevent_convert_list (c);
1183
1184 if (SYMBOLP (c))
1185 silly_event_symbol_error (c);
1186
1187 if (INTEGERP (c)
1188 && (XINT (c) & meta_bit)
1189 && !metized)
1190 {
1191 c = meta_prefix_char;
1192 metized = 1;
1193 }
1194 else
1195 {
1196 if (INTEGERP (c))
1197 XSETINT (c, XINT (c) & ~meta_bit);
1198
1199 metized = 0;
1200 idx++;
1201 }
1202
1203 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
1204 error ("Key sequence contains invalid event");
1205
1206 if (idx == length)
1207 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1208
1209 cmd = access_keymap (keymap, c, 0, 1, 1);
1210
1211 /* If this key is undefined, make it a prefix. */
1212 if (NILP (cmd))
1213 cmd = define_as_prefix (keymap, c);
1214
1215 keymap = get_keymap (cmd, 0, 1);
1216 if (!CONSP (keymap))
1217 /* We must use Fkey_description rather than just passing key to
1218 error; key might be a vector, not a string. */
1219 error ("Key sequence %s starts with non-prefix key %s",
1220 SDATA (Fkey_description (key, Qnil)),
1221 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1222 make_number (idx)),
1223 Qnil)));
1224 }
1225 }
1226
1227 /* This function may GC (it calls Fkey_binding). */
1228
1229 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1230 doc: /* Return the remapping for command COMMAND.
1231 Returns nil if COMMAND is not remapped (or not a symbol).
1232
1233 If the optional argument POSITION is non-nil, it specifies a mouse
1234 position as returned by `event-start' and `event-end', and the
1235 remapping occurs in the keymaps associated with it. It can also be a
1236 number or marker, in which case the keymap properties at the specified
1237 buffer position instead of point are used. The KEYMAPS argument is
1238 ignored if POSITION is non-nil.
1239
1240 If the optional argument KEYMAPS is non-nil, it should be a list of
1241 keymaps to search for command remapping. Otherwise, search for the
1242 remapping in all currently active keymaps. */)
1243 (command, position, keymaps)
1244 Lisp_Object command, position, keymaps;
1245 {
1246 if (!SYMBOLP (command))
1247 return Qnil;
1248
1249 ASET (command_remapping_vector, 1, command);
1250
1251 if (NILP (keymaps))
1252 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1253 else
1254 {
1255 Lisp_Object maps, binding;
1256
1257 for (maps = keymaps; !NILP (maps); maps = Fcdr (maps))
1258 {
1259 binding = Flookup_key (Fcar (maps), command_remapping_vector, Qnil);
1260 if (!NILP (binding) && !INTEGERP (binding))
1261 return binding;
1262 }
1263 return Qnil;
1264 }
1265 }
1266
1267 /* Value is number if KEY is too long; nil if valid but has no definition. */
1268 /* GC is possible in this function if it autoloads a keymap. */
1269
1270 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1271 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1272 A value of nil means undefined. See doc of `define-key'
1273 for kinds of definitions.
1274
1275 A number as value means KEY is "too long";
1276 that is, characters or symbols in it except for the last one
1277 fail to be a valid sequence of prefix characters in KEYMAP.
1278 The number is how many characters at the front of KEY
1279 it takes to reach a non-prefix key.
1280
1281 Normally, `lookup-key' ignores bindings for t, which act as default
1282 bindings, used when nothing else in the keymap applies; this makes it
1283 usable as a general function for probing keymaps. However, if the
1284 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1285 recognize the default bindings, just as `read-key-sequence' does. */)
1286 (keymap, key, accept_default)
1287 Lisp_Object keymap;
1288 Lisp_Object key;
1289 Lisp_Object accept_default;
1290 {
1291 register int idx;
1292 register Lisp_Object cmd;
1293 register Lisp_Object c;
1294 int length;
1295 int t_ok = !NILP (accept_default);
1296 struct gcpro gcpro1, gcpro2;
1297
1298 GCPRO2 (keymap, key);
1299 keymap = get_keymap (keymap, 1, 1);
1300
1301 CHECK_VECTOR_OR_STRING (key);
1302
1303 length = XFASTINT (Flength (key));
1304 if (length == 0)
1305 RETURN_UNGCPRO (keymap);
1306
1307 idx = 0;
1308 while (1)
1309 {
1310 c = Faref (key, make_number (idx++));
1311
1312 if (CONSP (c) && lucid_event_type_list_p (c))
1313 c = Fevent_convert_list (c);
1314
1315 /* Turn the 8th bit of string chars into a meta modifier. */
1316 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1317 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1318
1319 /* Allow string since binding for `menu-bar-select-buffer'
1320 includes the buffer name in the key sequence. */
1321 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1322 error ("Key sequence contains invalid event");
1323
1324 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1325 if (idx == length)
1326 RETURN_UNGCPRO (cmd);
1327
1328 keymap = get_keymap (cmd, 0, 1);
1329 if (!CONSP (keymap))
1330 RETURN_UNGCPRO (make_number (idx));
1331
1332 QUIT;
1333 }
1334 }
1335
1336 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1337 Assume that currently it does not define C at all.
1338 Return the keymap. */
1339
1340 static Lisp_Object
1341 define_as_prefix (keymap, c)
1342 Lisp_Object keymap, c;
1343 {
1344 Lisp_Object cmd;
1345
1346 cmd = Fmake_sparse_keymap (Qnil);
1347 /* If this key is defined as a prefix in an inherited keymap,
1348 make it a prefix in this map, and make its definition
1349 inherit the other prefix definition. */
1350 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1351 store_in_keymap (keymap, c, cmd);
1352
1353 return cmd;
1354 }
1355
1356 /* Append a key to the end of a key sequence. We always make a vector. */
1357
1358 Lisp_Object
1359 append_key (key_sequence, key)
1360 Lisp_Object key_sequence, key;
1361 {
1362 Lisp_Object args[2];
1363
1364 args[0] = key_sequence;
1365
1366 args[1] = Fcons (key, Qnil);
1367 return Fvconcat (2, args);
1368 }
1369
1370 /* Given a event type C which is a symbol,
1371 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1372
1373 static void
1374 silly_event_symbol_error (c)
1375 Lisp_Object c;
1376 {
1377 Lisp_Object parsed, base, name, assoc;
1378 int modifiers;
1379
1380 parsed = parse_modifiers (c);
1381 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1382 base = XCAR (parsed);
1383 name = Fsymbol_name (base);
1384 /* This alist includes elements such as ("RET" . "\\r"). */
1385 assoc = Fassoc (name, exclude_keys);
1386
1387 if (! NILP (assoc))
1388 {
1389 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1390 char *p = new_mods;
1391 Lisp_Object keystring;
1392 if (modifiers & alt_modifier)
1393 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1394 if (modifiers & ctrl_modifier)
1395 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1396 if (modifiers & hyper_modifier)
1397 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1398 if (modifiers & meta_modifier)
1399 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1400 if (modifiers & shift_modifier)
1401 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1402 if (modifiers & super_modifier)
1403 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1404 *p = 0;
1405
1406 c = reorder_modifiers (c);
1407 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1408
1409 error ((modifiers & ~meta_modifier
1410 ? "To bind the key %s, use [?%s], not [%s]"
1411 : "To bind the key %s, use \"%s\", not [%s]"),
1412 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1413 SDATA (SYMBOL_NAME (c)));
1414 }
1415 }
1416 \f
1417 /* Global, local, and minor mode keymap stuff. */
1418
1419 /* We can't put these variables inside current_minor_maps, since under
1420 some systems, static gets macro-defined to be the empty string.
1421 Ickypoo. */
1422 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1423 static int cmm_size = 0;
1424
1425 /* Store a pointer to an array of the currently active minor modes in
1426 *modeptr, a pointer to an array of the keymaps of the currently
1427 active minor modes in *mapptr, and return the number of maps
1428 *mapptr contains.
1429
1430 This function always returns a pointer to the same buffer, and may
1431 free or reallocate it, so if you want to keep it for a long time or
1432 hand it out to lisp code, copy it. This procedure will be called
1433 for every key sequence read, so the nice lispy approach (return a
1434 new assoclist, list, what have you) for each invocation would
1435 result in a lot of consing over time.
1436
1437 If we used xrealloc/xmalloc and ran out of memory, they would throw
1438 back to the command loop, which would try to read a key sequence,
1439 which would call this function again, resulting in an infinite
1440 loop. Instead, we'll use realloc/malloc and silently truncate the
1441 list, let the key sequence be read, and hope some other piece of
1442 code signals the error. */
1443 int
1444 current_minor_maps (modeptr, mapptr)
1445 Lisp_Object **modeptr, **mapptr;
1446 {
1447 int i = 0;
1448 int list_number = 0;
1449 Lisp_Object alist, assoc, var, val;
1450 Lisp_Object emulation_alists;
1451 Lisp_Object lists[2];
1452
1453 emulation_alists = Vemulation_mode_map_alists;
1454 lists[0] = Vminor_mode_overriding_map_alist;
1455 lists[1] = Vminor_mode_map_alist;
1456
1457 for (list_number = 0; list_number < 2; list_number++)
1458 {
1459 if (CONSP (emulation_alists))
1460 {
1461 alist = XCAR (emulation_alists);
1462 emulation_alists = XCDR (emulation_alists);
1463 if (SYMBOLP (alist))
1464 alist = find_symbol_value (alist);
1465 list_number = -1;
1466 }
1467 else
1468 alist = lists[list_number];
1469
1470 for ( ; CONSP (alist); alist = XCDR (alist))
1471 if ((assoc = XCAR (alist), CONSP (assoc))
1472 && (var = XCAR (assoc), SYMBOLP (var))
1473 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1474 && !NILP (val))
1475 {
1476 Lisp_Object temp;
1477
1478 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1479 and also an entry in Vminor_mode_map_alist,
1480 ignore the latter. */
1481 if (list_number == 1)
1482 {
1483 val = assq_no_quit (var, lists[0]);
1484 if (!NILP (val))
1485 continue;
1486 }
1487
1488 if (i >= cmm_size)
1489 {
1490 int newsize, allocsize;
1491 Lisp_Object *newmodes, *newmaps;
1492
1493 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1494 allocsize = newsize * sizeof *newmodes;
1495
1496 /* Use malloc here. See the comment above this function.
1497 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1498 BLOCK_INPUT;
1499 newmodes = (Lisp_Object *) malloc (allocsize);
1500 if (newmodes)
1501 {
1502 if (cmm_modes)
1503 {
1504 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1505 free (cmm_modes);
1506 }
1507 cmm_modes = newmodes;
1508 }
1509
1510 newmaps = (Lisp_Object *) malloc (allocsize);
1511 if (newmaps)
1512 {
1513 if (cmm_maps)
1514 {
1515 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1516 free (cmm_maps);
1517 }
1518 cmm_maps = newmaps;
1519 }
1520 UNBLOCK_INPUT;
1521
1522 if (newmodes == NULL || newmaps == NULL)
1523 break;
1524 cmm_size = newsize;
1525 }
1526
1527 /* Get the keymap definition--or nil if it is not defined. */
1528 temp = Findirect_function (XCDR (assoc), Qt);
1529 if (!NILP (temp))
1530 {
1531 cmm_modes[i] = var;
1532 cmm_maps [i] = temp;
1533 i++;
1534 }
1535 }
1536 }
1537
1538 if (modeptr) *modeptr = cmm_modes;
1539 if (mapptr) *mapptr = cmm_maps;
1540 return i;
1541 }
1542
1543 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1544 0, 1, 0,
1545 doc: /* Return a list of the currently active keymaps.
1546 OLP if non-nil indicates that we should obey `overriding-local-map' and
1547 `overriding-terminal-local-map'. */)
1548 (olp)
1549 Lisp_Object olp;
1550 {
1551 Lisp_Object keymaps = Fcons (current_global_map, Qnil);
1552
1553 if (!NILP (olp))
1554 {
1555 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1556 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1557 /* The doc said that overriding-terminal-local-map should
1558 override overriding-local-map. The code used them both,
1559 but it seems clearer to use just one. rms, jan 2005. */
1560 else if (!NILP (Voverriding_local_map))
1561 keymaps = Fcons (Voverriding_local_map, keymaps);
1562 }
1563 if (NILP (XCDR (keymaps)))
1564 {
1565 Lisp_Object local;
1566 Lisp_Object *maps;
1567 int nmaps, i;
1568
1569 /* This usually returns the buffer's local map,
1570 but that can be overridden by a `local-map' property. */
1571 local = get_local_map (PT, current_buffer, Qlocal_map);
1572 if (!NILP (local))
1573 keymaps = Fcons (local, keymaps);
1574
1575 /* Now put all the minor mode keymaps on the list. */
1576 nmaps = current_minor_maps (0, &maps);
1577
1578 for (i = --nmaps; i >= 0; i--)
1579 if (!NILP (maps[i]))
1580 keymaps = Fcons (maps[i], keymaps);
1581
1582 /* This returns nil unless there is a `keymap' property. */
1583 local = get_local_map (PT, current_buffer, Qkeymap);
1584 if (!NILP (local))
1585 keymaps = Fcons (local, keymaps);
1586 }
1587
1588 return keymaps;
1589 }
1590
1591 /* GC is possible in this function if it autoloads a keymap. */
1592
1593 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1594 doc: /* Return the binding for command KEY in current keymaps.
1595 KEY is a string or vector, a sequence of keystrokes.
1596 The binding is probably a symbol with a function definition.
1597
1598 Normally, `key-binding' ignores bindings for t, which act as default
1599 bindings, used when nothing else in the keymap applies; this makes it
1600 usable as a general function for probing keymaps. However, if the
1601 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1602 recognize the default bindings, just as `read-key-sequence' does.
1603
1604 Like the normal command loop, `key-binding' will remap the command
1605 resulting from looking up KEY by looking up the command in the
1606 current keymaps. However, if the optional third argument NO-REMAP
1607 is non-nil, `key-binding' returns the unmapped command.
1608
1609 If KEY is a key sequence initiated with the mouse, the used keymaps
1610 will depend on the clicked mouse position with regard to the buffer
1611 and possible local keymaps on strings.
1612
1613 If the optional argument POSITION is non-nil, it specifies a mouse
1614 position as returned by `event-start' and `event-end', and the lookup
1615 occurs in the keymaps associated with it instead of KEY. It can also
1616 be a number or marker, in which case the keymap properties at the
1617 specified buffer position instead of point are used.
1618 */)
1619 (key, accept_default, no_remap, position)
1620 Lisp_Object key, accept_default, no_remap, position;
1621 {
1622 Lisp_Object *maps, value;
1623 int nmaps, i;
1624 struct gcpro gcpro1, gcpro2;
1625 int count = SPECPDL_INDEX ();
1626
1627 GCPRO2 (key, position);
1628
1629 if (NILP (position) && VECTORP (key))
1630 {
1631 Lisp_Object event
1632 /* mouse events may have a symbolic prefix indicating the
1633 scrollbar or mode line */
1634 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1635
1636 /* We are not interested in locations without event data */
1637
1638 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1639 {
1640 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1641 if (EQ (kind, Qmouse_click))
1642 position = EVENT_START (event);
1643 }
1644 }
1645
1646 /* Key sequences beginning with mouse clicks
1647 are read using the keymaps of the buffer clicked on, not
1648 the current buffer. So we may have to switch the buffer
1649 here. */
1650
1651 if (CONSP (position))
1652 {
1653 Lisp_Object window;
1654
1655 window = POSN_WINDOW (position);
1656
1657 if (WINDOWP (window)
1658 && BUFFERP (XWINDOW (window)->buffer)
1659 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1660 {
1661 /* Arrange to go back to the original buffer once we're done
1662 processing the key sequence. We don't use
1663 save_excursion_{save,restore} here, in analogy to
1664 `read-key-sequence' to avoid saving point. Maybe this
1665 would not be a problem here, but it is easier to keep
1666 things the same.
1667 */
1668
1669 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1670
1671 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1672 }
1673 }
1674
1675 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1676 {
1677 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1678 key, accept_default);
1679 if (! NILP (value) && !INTEGERP (value))
1680 goto done;
1681 }
1682 else if (! NILP (Voverriding_local_map))
1683 {
1684 value = Flookup_key (Voverriding_local_map, key, accept_default);
1685 if (! NILP (value) && !INTEGERP (value))
1686 goto done;
1687 }
1688 else
1689 {
1690 Lisp_Object keymap, local_map;
1691 EMACS_INT pt;
1692
1693 pt = INTEGERP (position) ? XINT (position)
1694 : MARKERP (position) ? marker_position (position)
1695 : PT;
1696
1697 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1698 keymap = get_local_map (pt, current_buffer, Qkeymap);
1699
1700 if (CONSP (position))
1701 {
1702 Lisp_Object string;
1703
1704 /* For a mouse click, get the local text-property keymap
1705 of the place clicked on, rather than point. */
1706
1707 if (POSN_INBUFFER_P (position))
1708 {
1709 Lisp_Object pos;
1710
1711 pos = POSN_BUFFER_POSN (position);
1712 if (INTEGERP (pos)
1713 && XINT (pos) >= BEG && XINT (pos) <= Z)
1714 {
1715 local_map = get_local_map (XINT (pos),
1716 current_buffer, Qlocal_map);
1717
1718 keymap = get_local_map (XINT (pos),
1719 current_buffer, Qkeymap);
1720 }
1721 }
1722
1723 /* If on a mode line string with a local keymap,
1724 or for a click on a string, i.e. overlay string or a
1725 string displayed via the `display' property,
1726 consider `local-map' and `keymap' properties of
1727 that string. */
1728
1729 if (string = POSN_STRING (position),
1730 (CONSP (string) && STRINGP (XCAR (string))))
1731 {
1732 Lisp_Object pos, map;
1733
1734 pos = XCDR (string);
1735 string = XCAR (string);
1736 if (INTEGERP (pos)
1737 && XINT (pos) >= 0
1738 && XINT (pos) < SCHARS (string))
1739 {
1740 map = Fget_text_property (pos, Qlocal_map, string);
1741 if (!NILP (map))
1742 local_map = map;
1743
1744 map = Fget_text_property (pos, Qkeymap, string);
1745 if (!NILP (map))
1746 keymap = map;
1747 }
1748 }
1749
1750 }
1751
1752 if (! NILP (keymap))
1753 {
1754 value = Flookup_key (keymap, key, accept_default);
1755 if (! NILP (value) && !INTEGERP (value))
1756 goto done;
1757 }
1758
1759 nmaps = current_minor_maps (0, &maps);
1760 /* Note that all these maps are GCPRO'd
1761 in the places where we found them. */
1762
1763 for (i = 0; i < nmaps; i++)
1764 if (! NILP (maps[i]))
1765 {
1766 value = Flookup_key (maps[i], key, accept_default);
1767 if (! NILP (value) && !INTEGERP (value))
1768 goto done;
1769 }
1770
1771 if (! NILP (local_map))
1772 {
1773 value = Flookup_key (local_map, key, accept_default);
1774 if (! NILP (value) && !INTEGERP (value))
1775 goto done;
1776 }
1777 }
1778
1779 value = Flookup_key (current_global_map, key, accept_default);
1780
1781 done:
1782 unbind_to (count, Qnil);
1783
1784 UNGCPRO;
1785 if (NILP (value) || INTEGERP (value))
1786 return Qnil;
1787
1788 /* If the result of the ordinary keymap lookup is an interactive
1789 command, look for a key binding (ie. remapping) for that command. */
1790
1791 if (NILP (no_remap) && SYMBOLP (value))
1792 {
1793 Lisp_Object value1;
1794 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1795 value = value1;
1796 }
1797
1798 return value;
1799 }
1800
1801 /* GC is possible in this function if it autoloads a keymap. */
1802
1803 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1804 doc: /* Return the binding for command KEYS in current local keymap only.
1805 KEYS is a string or vector, a sequence of keystrokes.
1806 The binding is probably a symbol with a function definition.
1807
1808 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1809 bindings; see the description of `lookup-key' for more details about this. */)
1810 (keys, accept_default)
1811 Lisp_Object keys, accept_default;
1812 {
1813 register Lisp_Object map;
1814 map = current_buffer->keymap;
1815 if (NILP (map))
1816 return Qnil;
1817 return Flookup_key (map, keys, accept_default);
1818 }
1819
1820 /* GC is possible in this function if it autoloads a keymap. */
1821
1822 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1823 doc: /* Return the binding for command KEYS in current global keymap only.
1824 KEYS is a string or vector, a sequence of keystrokes.
1825 The binding is probably a symbol with a function definition.
1826 This function's return values are the same as those of `lookup-key'
1827 \(which see).
1828
1829 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1830 bindings; see the description of `lookup-key' for more details about this. */)
1831 (keys, accept_default)
1832 Lisp_Object keys, accept_default;
1833 {
1834 return Flookup_key (current_global_map, keys, accept_default);
1835 }
1836
1837 /* GC is possible in this function if it autoloads a keymap. */
1838
1839 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1840 doc: /* Find the visible minor mode bindings of KEY.
1841 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1842 the symbol which names the minor mode binding KEY, and BINDING is
1843 KEY's definition in that mode. In particular, if KEY has no
1844 minor-mode bindings, return nil. If the first binding is a
1845 non-prefix, all subsequent bindings will be omitted, since they would
1846 be ignored. Similarly, the list doesn't include non-prefix bindings
1847 that come after prefix bindings.
1848
1849 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1850 bindings; see the description of `lookup-key' for more details about this. */)
1851 (key, accept_default)
1852 Lisp_Object key, accept_default;
1853 {
1854 Lisp_Object *modes, *maps;
1855 int nmaps;
1856 Lisp_Object binding;
1857 int i, j;
1858 struct gcpro gcpro1, gcpro2;
1859
1860 nmaps = current_minor_maps (&modes, &maps);
1861 /* Note that all these maps are GCPRO'd
1862 in the places where we found them. */
1863
1864 binding = Qnil;
1865 GCPRO2 (key, binding);
1866
1867 for (i = j = 0; i < nmaps; i++)
1868 if (!NILP (maps[i])
1869 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1870 && !INTEGERP (binding))
1871 {
1872 if (KEYMAPP (binding))
1873 maps[j++] = Fcons (modes[i], binding);
1874 else if (j == 0)
1875 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1876 }
1877
1878 UNGCPRO;
1879 return Flist (j, maps);
1880 }
1881
1882 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1883 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1884 A new sparse keymap is stored as COMMAND's function definition and its value.
1885 If a second optional argument MAPVAR is given, the map is stored as
1886 its value instead of as COMMAND's value; but COMMAND is still defined
1887 as a function.
1888 The third optional argument NAME, if given, supplies a menu name
1889 string for the map. This is required to use the keymap as a menu.
1890 This function returns COMMAND. */)
1891 (command, mapvar, name)
1892 Lisp_Object command, mapvar, name;
1893 {
1894 Lisp_Object map;
1895 map = Fmake_sparse_keymap (name);
1896 Ffset (command, map);
1897 if (!NILP (mapvar))
1898 Fset (mapvar, map);
1899 else
1900 Fset (command, map);
1901 return command;
1902 }
1903
1904 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1905 doc: /* Select KEYMAP as the global keymap. */)
1906 (keymap)
1907 Lisp_Object keymap;
1908 {
1909 keymap = get_keymap (keymap, 1, 1);
1910 current_global_map = keymap;
1911
1912 return Qnil;
1913 }
1914
1915 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1916 doc: /* Select KEYMAP as the local keymap.
1917 If KEYMAP is nil, that means no local keymap. */)
1918 (keymap)
1919 Lisp_Object keymap;
1920 {
1921 if (!NILP (keymap))
1922 keymap = get_keymap (keymap, 1, 1);
1923
1924 current_buffer->keymap = keymap;
1925
1926 return Qnil;
1927 }
1928
1929 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1930 doc: /* Return current buffer's local keymap, or nil if it has none. */)
1931 ()
1932 {
1933 return current_buffer->keymap;
1934 }
1935
1936 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1937 doc: /* Return the current global keymap. */)
1938 ()
1939 {
1940 return current_global_map;
1941 }
1942
1943 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1944 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
1945 ()
1946 {
1947 Lisp_Object *maps;
1948 int nmaps = current_minor_maps (0, &maps);
1949
1950 return Flist (nmaps, maps);
1951 }
1952 \f
1953 /* Help functions for describing and documenting keymaps. */
1954
1955
1956 static void
1957 accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
1958 Lisp_Object maps, tail, thisseq, key, cmd;
1959 int is_metized; /* If 1, `key' is assumed to be INTEGERP. */
1960 {
1961 Lisp_Object tem;
1962
1963 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
1964 if (NILP (cmd))
1965 return;
1966
1967 /* Look for and break cycles. */
1968 while (!NILP (tem = Frassq (cmd, maps)))
1969 {
1970 Lisp_Object prefix = XCAR (tem);
1971 int lim = XINT (Flength (XCAR (tem)));
1972 if (lim <= XINT (Flength (thisseq)))
1973 { /* This keymap was already seen with a smaller prefix. */
1974 int i = 0;
1975 while (i < lim && EQ (Faref (prefix, make_number (i)),
1976 Faref (thisseq, make_number (i))))
1977 i++;
1978 if (i >= lim)
1979 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1980 return;
1981 }
1982 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1983 but maybe `cmd' occurs again further down in `maps', so keep
1984 looking. */
1985 maps = XCDR (Fmemq (tem, maps));
1986 }
1987
1988 /* If the last key in thisseq is meta-prefix-char,
1989 turn it into a meta-ized keystroke. We know
1990 that the event we're about to append is an
1991 ascii keystroke since we're processing a
1992 keymap table. */
1993 if (is_metized)
1994 {
1995 int meta_bit = meta_modifier;
1996 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
1997 tem = Fcopy_sequence (thisseq);
1998
1999 Faset (tem, last, make_number (XINT (key) | meta_bit));
2000
2001 /* This new sequence is the same length as
2002 thisseq, so stick it in the list right
2003 after this one. */
2004 XSETCDR (tail,
2005 Fcons (Fcons (tem, cmd), XCDR (tail)));
2006 }
2007 else
2008 {
2009 tem = append_key (thisseq, key);
2010 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2011 }
2012 }
2013
2014 static void
2015 accessible_keymaps_char_table (args, index, cmd)
2016 Lisp_Object args, index, cmd;
2017 {
2018 accessible_keymaps_1 (index, cmd,
2019 XCAR (XCAR (args)),
2020 XCAR (XCDR (args)),
2021 XCDR (XCDR (args)),
2022 XINT (XCDR (XCAR (args))));
2023 }
2024
2025 /* This function cannot GC. */
2026
2027 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2028 1, 2, 0,
2029 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2030 Returns a list of elements of the form (KEYS . MAP), where the sequence
2031 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2032 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2033 An optional argument PREFIX, if non-nil, should be a key sequence;
2034 then the value includes only maps for prefixes that start with PREFIX. */)
2035 (keymap, prefix)
2036 Lisp_Object keymap, prefix;
2037 {
2038 Lisp_Object maps, tail;
2039 int prefixlen = 0;
2040
2041 /* no need for gcpro because we don't autoload any keymaps. */
2042
2043 if (!NILP (prefix))
2044 prefixlen = XINT (Flength (prefix));
2045
2046 if (!NILP (prefix))
2047 {
2048 /* If a prefix was specified, start with the keymap (if any) for
2049 that prefix, so we don't waste time considering other prefixes. */
2050 Lisp_Object tem;
2051 tem = Flookup_key (keymap, prefix, Qt);
2052 /* Flookup_key may give us nil, or a number,
2053 if the prefix is not defined in this particular map.
2054 It might even give us a list that isn't a keymap. */
2055 tem = get_keymap (tem, 0, 0);
2056 if (CONSP (tem))
2057 {
2058 /* Convert PREFIX to a vector now, so that later on
2059 we don't have to deal with the possibility of a string. */
2060 if (STRINGP (prefix))
2061 {
2062 int i, i_byte, c;
2063 Lisp_Object copy;
2064
2065 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2066 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2067 {
2068 int i_before = i;
2069
2070 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2071 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2072 c ^= 0200 | meta_modifier;
2073 ASET (copy, i_before, make_number (c));
2074 }
2075 prefix = copy;
2076 }
2077 maps = Fcons (Fcons (prefix, tem), Qnil);
2078 }
2079 else
2080 return Qnil;
2081 }
2082 else
2083 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2084 get_keymap (keymap, 1, 0)),
2085 Qnil);
2086
2087 /* For each map in the list maps,
2088 look at any other maps it points to,
2089 and stick them at the end if they are not already in the list.
2090
2091 This is a breadth-first traversal, where tail is the queue of
2092 nodes, and maps accumulates a list of all nodes visited. */
2093
2094 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2095 {
2096 register Lisp_Object thisseq, thismap;
2097 Lisp_Object last;
2098 /* Does the current sequence end in the meta-prefix-char? */
2099 int is_metized;
2100
2101 thisseq = Fcar (Fcar (tail));
2102 thismap = Fcdr (Fcar (tail));
2103 last = make_number (XINT (Flength (thisseq)) - 1);
2104 is_metized = (XINT (last) >= 0
2105 /* Don't metize the last char of PREFIX. */
2106 && XINT (last) >= prefixlen
2107 && EQ (Faref (thisseq, last), meta_prefix_char));
2108
2109 for (; CONSP (thismap); thismap = XCDR (thismap))
2110 {
2111 Lisp_Object elt;
2112
2113 elt = XCAR (thismap);
2114
2115 QUIT;
2116
2117 if (CHAR_TABLE_P (elt))
2118 {
2119 Lisp_Object indices[3];
2120
2121 map_char_table (accessible_keymaps_char_table, Qnil, elt,
2122 elt, Fcons (Fcons (maps, make_number (is_metized)),
2123 Fcons (tail, thisseq)),
2124 0, indices);
2125 }
2126 else if (VECTORP (elt))
2127 {
2128 register int i;
2129
2130 /* Vector keymap. Scan all the elements. */
2131 for (i = 0; i < ASIZE (elt); i++)
2132 accessible_keymaps_1 (make_number (i), AREF (elt, i),
2133 maps, tail, thisseq, is_metized);
2134
2135 }
2136 else if (CONSP (elt))
2137 accessible_keymaps_1 (XCAR (elt), XCDR (elt),
2138 maps, tail, thisseq,
2139 is_metized && INTEGERP (XCAR (elt)));
2140
2141 }
2142 }
2143
2144 return maps;
2145 }
2146 \f
2147 Lisp_Object Qsingle_key_description, Qkey_description;
2148
2149 /* This function cannot GC. */
2150
2151 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2152 doc: /* Return a pretty description of key-sequence KEYS.
2153 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2154 Control characters turn into "C-foo" sequences, meta into "M-foo",
2155 spaces are put between sequence elements, etc. */)
2156 (keys, prefix)
2157 Lisp_Object keys, prefix;
2158 {
2159 int len = 0;
2160 int i, i_byte;
2161 Lisp_Object *args;
2162 int size = XINT (Flength (keys));
2163 Lisp_Object list;
2164 Lisp_Object sep = build_string (" ");
2165 Lisp_Object key;
2166 int add_meta = 0;
2167
2168 if (!NILP (prefix))
2169 size += XINT (Flength (prefix));
2170
2171 /* This has one extra element at the end that we don't pass to Fconcat. */
2172 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2173
2174 /* In effect, this computes
2175 (mapconcat 'single-key-description keys " ")
2176 but we shouldn't use mapconcat because it can do GC. */
2177
2178 next_list:
2179 if (!NILP (prefix))
2180 list = prefix, prefix = Qnil;
2181 else if (!NILP (keys))
2182 list = keys, keys = Qnil;
2183 else
2184 {
2185 if (add_meta)
2186 {
2187 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2188 len += 2;
2189 }
2190 else if (len == 0)
2191 return empty_string;
2192 return Fconcat (len - 1, args);
2193 }
2194
2195 if (STRINGP (list))
2196 size = SCHARS (list);
2197 else if (VECTORP (list))
2198 size = XVECTOR (list)->size;
2199 else if (CONSP (list))
2200 size = XINT (Flength (list));
2201 else
2202 wrong_type_argument (Qarrayp, list);
2203
2204 i = i_byte = 0;
2205
2206 while (i < size)
2207 {
2208 if (STRINGP (list))
2209 {
2210 int c;
2211 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2212 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2213 c ^= 0200 | meta_modifier;
2214 XSETFASTINT (key, c);
2215 }
2216 else if (VECTORP (list))
2217 {
2218 key = AREF (list, i++);
2219 }
2220 else
2221 {
2222 key = XCAR (list);
2223 list = XCDR (list);
2224 i++;
2225 }
2226
2227 if (add_meta)
2228 {
2229 if (!INTEGERP (key)
2230 || EQ (key, meta_prefix_char)
2231 || (XINT (key) & meta_modifier))
2232 {
2233 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2234 args[len++] = sep;
2235 if (EQ (key, meta_prefix_char))
2236 continue;
2237 }
2238 else
2239 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2240 add_meta = 0;
2241 }
2242 else if (EQ (key, meta_prefix_char))
2243 {
2244 add_meta = 1;
2245 continue;
2246 }
2247 args[len++] = Fsingle_key_description (key, Qnil);
2248 args[len++] = sep;
2249 }
2250 goto next_list;
2251 }
2252
2253
2254 char *
2255 push_key_description (c, p, force_multibyte)
2256 register unsigned int c;
2257 register char *p;
2258 int force_multibyte;
2259 {
2260 unsigned c2;
2261 int valid_p;
2262
2263 /* Clear all the meaningless bits above the meta bit. */
2264 c &= meta_modifier | ~ - meta_modifier;
2265 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2266 | meta_modifier | shift_modifier | super_modifier);
2267
2268 valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0);
2269 if (! valid_p)
2270 {
2271 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2272 p += sprintf (p, "[%d]", c);
2273 return p;
2274 }
2275
2276 if (c & alt_modifier)
2277 {
2278 *p++ = 'A';
2279 *p++ = '-';
2280 c -= alt_modifier;
2281 }
2282 if ((c & ctrl_modifier) != 0
2283 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2284 {
2285 *p++ = 'C';
2286 *p++ = '-';
2287 c &= ~ctrl_modifier;
2288 }
2289 if (c & hyper_modifier)
2290 {
2291 *p++ = 'H';
2292 *p++ = '-';
2293 c -= hyper_modifier;
2294 }
2295 if (c & meta_modifier)
2296 {
2297 *p++ = 'M';
2298 *p++ = '-';
2299 c -= meta_modifier;
2300 }
2301 if (c & shift_modifier)
2302 {
2303 *p++ = 'S';
2304 *p++ = '-';
2305 c -= shift_modifier;
2306 }
2307 if (c & super_modifier)
2308 {
2309 *p++ = 's';
2310 *p++ = '-';
2311 c -= super_modifier;
2312 }
2313 if (c < 040)
2314 {
2315 if (c == 033)
2316 {
2317 *p++ = 'E';
2318 *p++ = 'S';
2319 *p++ = 'C';
2320 }
2321 else if (c == '\t')
2322 {
2323 *p++ = 'T';
2324 *p++ = 'A';
2325 *p++ = 'B';
2326 }
2327 else if (c == Ctl ('M'))
2328 {
2329 *p++ = 'R';
2330 *p++ = 'E';
2331 *p++ = 'T';
2332 }
2333 else
2334 {
2335 /* `C-' already added above. */
2336 if (c > 0 && c <= Ctl ('Z'))
2337 *p++ = c + 0140;
2338 else
2339 *p++ = c + 0100;
2340 }
2341 }
2342 else if (c == 0177)
2343 {
2344 *p++ = 'D';
2345 *p++ = 'E';
2346 *p++ = 'L';
2347 }
2348 else if (c == ' ')
2349 {
2350 *p++ = 'S';
2351 *p++ = 'P';
2352 *p++ = 'C';
2353 }
2354 else if (c < 128
2355 || (NILP (current_buffer->enable_multibyte_characters)
2356 && SINGLE_BYTE_CHAR_P (c)
2357 && !force_multibyte))
2358 {
2359 *p++ = c;
2360 }
2361 else
2362 {
2363 if (force_multibyte)
2364 {
2365 if (SINGLE_BYTE_CHAR_P (c))
2366 c = unibyte_char_to_multibyte (c);
2367 p += CHAR_STRING (c, p);
2368 }
2369 else if (NILP (current_buffer->enable_multibyte_characters))
2370 {
2371 int bit_offset;
2372 *p++ = '\\';
2373 /* The biggest character code uses 19 bits. */
2374 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
2375 {
2376 if (c >= (1 << bit_offset))
2377 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
2378 }
2379 }
2380 else
2381 p += CHAR_STRING (c, p);
2382 }
2383
2384 return p;
2385 }
2386
2387 /* This function cannot GC. */
2388
2389 DEFUN ("single-key-description", Fsingle_key_description,
2390 Ssingle_key_description, 1, 2, 0,
2391 doc: /* Return a pretty description of command character KEY.
2392 Control characters turn into C-whatever, etc.
2393 Optional argument NO-ANGLES non-nil means don't put angle brackets
2394 around function keys and event symbols. */)
2395 (key, no_angles)
2396 Lisp_Object key, no_angles;
2397 {
2398 if (CONSP (key) && lucid_event_type_list_p (key))
2399 key = Fevent_convert_list (key);
2400
2401 key = EVENT_HEAD (key);
2402
2403 if (INTEGERP (key)) /* Normal character */
2404 {
2405 unsigned int charset, c1, c2;
2406 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
2407
2408 if (SINGLE_BYTE_CHAR_P (without_bits))
2409 charset = 0;
2410 else
2411 SPLIT_CHAR (without_bits, charset, c1, c2);
2412
2413 if (! CHAR_VALID_P (without_bits, 1))
2414 {
2415 char buf[256];
2416
2417 sprintf (buf, "Invalid char code %d", XINT (key));
2418 return build_string (buf);
2419 }
2420 else if (charset
2421 && ((c1 == 0 && c2 == -1) || c2 == 0))
2422 {
2423 /* Handle a generic character. */
2424 Lisp_Object name;
2425 char buf[256];
2426
2427 name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
2428 CHECK_STRING (name);
2429 if (c1 == 0)
2430 /* Only a charset is specified. */
2431 sprintf (buf, "Generic char %d: all of ", without_bits);
2432 else
2433 /* 1st code-point of 2-dimensional charset is specified. */
2434 sprintf (buf, "Generic char %d: row %d of ", without_bits, c1);
2435 return concat2 (build_string (buf), name);
2436 }
2437 else
2438 {
2439 char tem[KEY_DESCRIPTION_SIZE], *end;
2440 int nbytes, nchars;
2441 Lisp_Object string;
2442
2443 end = push_key_description (XUINT (key), tem, 1);
2444 nbytes = end - tem;
2445 nchars = multibyte_chars_in_text (tem, nbytes);
2446 if (nchars == nbytes)
2447 {
2448 *end = '\0';
2449 string = build_string (tem);
2450 }
2451 else
2452 string = make_multibyte_string (tem, nchars, nbytes);
2453 return string;
2454 }
2455 }
2456 else if (SYMBOLP (key)) /* Function key or event-symbol */
2457 {
2458 if (NILP (no_angles))
2459 {
2460 char *buffer
2461 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2462 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2463 return build_string (buffer);
2464 }
2465 else
2466 return Fsymbol_name (key);
2467 }
2468 else if (STRINGP (key)) /* Buffer names in the menubar. */
2469 return Fcopy_sequence (key);
2470 else
2471 error ("KEY must be an integer, cons, symbol, or string");
2472 return Qnil;
2473 }
2474
2475 char *
2476 push_text_char_description (c, p)
2477 register unsigned int c;
2478 register char *p;
2479 {
2480 if (c >= 0200)
2481 {
2482 *p++ = 'M';
2483 *p++ = '-';
2484 c -= 0200;
2485 }
2486 if (c < 040)
2487 {
2488 *p++ = '^';
2489 *p++ = c + 64; /* 'A' - 1 */
2490 }
2491 else if (c == 0177)
2492 {
2493 *p++ = '^';
2494 *p++ = '?';
2495 }
2496 else
2497 *p++ = c;
2498 return p;
2499 }
2500
2501 /* This function cannot GC. */
2502
2503 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2504 doc: /* Return a pretty description of file-character CHARACTER.
2505 Control characters turn into "^char", etc. This differs from
2506 `single-key-description' which turns them into "C-char".
2507 Also, this function recognizes the 2**7 bit as the Meta character,
2508 whereas `single-key-description' uses the 2**27 bit for Meta.
2509 See Info node `(elisp)Describing Characters' for examples. */)
2510 (character)
2511 Lisp_Object character;
2512 {
2513 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2514 unsigned char str[6];
2515 int c;
2516
2517 CHECK_NUMBER (character);
2518
2519 c = XINT (character);
2520 if (!SINGLE_BYTE_CHAR_P (c))
2521 {
2522 int len = CHAR_STRING (c, str);
2523
2524 return make_multibyte_string (str, 1, len);
2525 }
2526
2527 *push_text_char_description (c & 0377, str) = 0;
2528
2529 return build_string (str);
2530 }
2531
2532 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2533 a meta bit. */
2534 static int
2535 ascii_sequence_p (seq)
2536 Lisp_Object seq;
2537 {
2538 int i;
2539 int len = XINT (Flength (seq));
2540
2541 for (i = 0; i < len; i++)
2542 {
2543 Lisp_Object ii, elt;
2544
2545 XSETFASTINT (ii, i);
2546 elt = Faref (seq, ii);
2547
2548 if (!INTEGERP (elt)
2549 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2550 return 0;
2551 }
2552
2553 return 1;
2554 }
2555
2556 \f
2557 /* where-is - finding a command in a set of keymaps. */
2558
2559 static Lisp_Object where_is_internal ();
2560 static Lisp_Object where_is_internal_1 ();
2561 static void where_is_internal_2 ();
2562
2563 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2564 Returns the first non-nil binding found in any of those maps. */
2565
2566 static Lisp_Object
2567 shadow_lookup (shadow, key, flag)
2568 Lisp_Object shadow, key, flag;
2569 {
2570 Lisp_Object tail, value;
2571
2572 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2573 {
2574 value = Flookup_key (XCAR (tail), key, flag);
2575 if (NATNUMP (value))
2576 {
2577 value = Flookup_key (XCAR (tail),
2578 Fsubstring (key, make_number (0), value), flag);
2579 if (!NILP (value))
2580 return Qnil;
2581 }
2582 else if (!NILP (value))
2583 return value;
2584 }
2585 return Qnil;
2586 }
2587
2588 static Lisp_Object Vmouse_events;
2589
2590 /* This function can GC if Flookup_key autoloads any keymaps. */
2591
2592 static Lisp_Object
2593 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2594 Lisp_Object definition, keymaps;
2595 Lisp_Object firstonly, noindirect, no_remap;
2596 {
2597 Lisp_Object maps = Qnil;
2598 Lisp_Object found, sequences;
2599 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2600 /* 1 means ignore all menu bindings entirely. */
2601 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2602
2603 found = keymaps;
2604 while (CONSP (found))
2605 {
2606 maps =
2607 nconc2 (maps,
2608 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2609 found = XCDR (found);
2610 }
2611
2612 GCPRO5 (definition, keymaps, maps, found, sequences);
2613 found = Qnil;
2614 sequences = Qnil;
2615
2616 /* If this command is remapped, then it has no key bindings
2617 of its own. */
2618 if (NILP (no_remap)
2619 && SYMBOLP (definition)
2620 && !NILP (Fcommand_remapping (definition, Qnil, keymaps)))
2621 RETURN_UNGCPRO (Qnil);
2622
2623 for (; !NILP (maps); maps = Fcdr (maps))
2624 {
2625 /* Key sequence to reach map, and the map that it reaches */
2626 register Lisp_Object this, map, tem;
2627
2628 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2629 [M-CHAR] sequences, check if last character of the sequence
2630 is the meta-prefix char. */
2631 Lisp_Object last;
2632 int last_is_meta;
2633
2634 this = Fcar (Fcar (maps));
2635 map = Fcdr (Fcar (maps));
2636 last = make_number (XINT (Flength (this)) - 1);
2637 last_is_meta = (XINT (last) >= 0
2638 && EQ (Faref (this, last), meta_prefix_char));
2639
2640 /* if (nomenus && !ascii_sequence_p (this)) */
2641 if (nomenus && XINT (last) >= 0
2642 && SYMBOLP (tem = Faref (this, make_number (0)))
2643 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2644 /* If no menu entries should be returned, skip over the
2645 keymaps bound to `menu-bar' and `tool-bar' and other
2646 non-ascii prefixes like `C-down-mouse-2'. */
2647 continue;
2648
2649 QUIT;
2650
2651 while (CONSP (map))
2652 {
2653 /* Because the code we want to run on each binding is rather
2654 large, we don't want to have two separate loop bodies for
2655 sparse keymap bindings and tables; we want to iterate one
2656 loop body over both keymap and vector bindings.
2657
2658 For this reason, if Fcar (map) is a vector, we don't
2659 advance map to the next element until i indicates that we
2660 have finished off the vector. */
2661 Lisp_Object elt, key, binding;
2662 elt = XCAR (map);
2663 map = XCDR (map);
2664
2665 sequences = Qnil;
2666
2667 QUIT;
2668
2669 /* Set key and binding to the current key and binding, and
2670 advance map and i to the next binding. */
2671 if (VECTORP (elt))
2672 {
2673 Lisp_Object sequence;
2674 int i;
2675 /* In a vector, look at each element. */
2676 for (i = 0; i < XVECTOR (elt)->size; i++)
2677 {
2678 binding = AREF (elt, i);
2679 XSETFASTINT (key, i);
2680 sequence = where_is_internal_1 (binding, key, definition,
2681 noindirect, this,
2682 last, nomenus, last_is_meta);
2683 if (!NILP (sequence))
2684 sequences = Fcons (sequence, sequences);
2685 }
2686 }
2687 else if (CHAR_TABLE_P (elt))
2688 {
2689 Lisp_Object indices[3];
2690 Lisp_Object args;
2691
2692 args = Fcons (Fcons (Fcons (definition, noindirect),
2693 Qnil), /* Result accumulator. */
2694 Fcons (Fcons (this, last),
2695 Fcons (make_number (nomenus),
2696 make_number (last_is_meta))));
2697 map_char_table (where_is_internal_2, Qnil, elt, elt, args,
2698 0, indices);
2699 sequences = XCDR (XCAR (args));
2700 }
2701 else if (CONSP (elt))
2702 {
2703 Lisp_Object sequence;
2704
2705 key = XCAR (elt);
2706 binding = XCDR (elt);
2707
2708 sequence = where_is_internal_1 (binding, key, definition,
2709 noindirect, this,
2710 last, nomenus, last_is_meta);
2711 if (!NILP (sequence))
2712 sequences = Fcons (sequence, sequences);
2713 }
2714
2715
2716 while (!NILP (sequences))
2717 {
2718 Lisp_Object sequence, remapped, function;
2719
2720 sequence = XCAR (sequences);
2721 sequences = XCDR (sequences);
2722
2723 /* If the current sequence is a command remapping with
2724 format [remap COMMAND], find the key sequences
2725 which run COMMAND, and use those sequences instead. */
2726 remapped = Qnil;
2727 if (NILP (no_remap)
2728 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2729 && EQ (AREF (sequence, 0), Qremap)
2730 && (function = AREF (sequence, 1), SYMBOLP (function)))
2731 {
2732 Lisp_Object remapped1;
2733
2734 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2735 if (CONSP (remapped1))
2736 {
2737 /* Verify that this key binding actually maps to the
2738 remapped command (see below). */
2739 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2740 continue;
2741 sequence = XCAR (remapped1);
2742 remapped = XCDR (remapped1);
2743 goto record_sequence;
2744 }
2745 }
2746
2747 /* Verify that this key binding is not shadowed by another
2748 binding for the same key, before we say it exists.
2749
2750 Mechanism: look for local definition of this key and if
2751 it is defined and does not match what we found then
2752 ignore this key.
2753
2754 Either nil or number as value from Flookup_key
2755 means undefined. */
2756 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2757 continue;
2758
2759 record_sequence:
2760 /* Don't annoy user with strings from a menu such as
2761 Select Paste. Change them all to "(any string)",
2762 so that there seems to be only one menu item
2763 to report. */
2764 if (! NILP (sequence))
2765 {
2766 Lisp_Object tem;
2767 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2768 if (STRINGP (tem))
2769 Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2770 build_string ("(any string)"));
2771 }
2772
2773 /* It is a true unshadowed match. Record it, unless it's already
2774 been seen (as could happen when inheriting keymaps). */
2775 if (NILP (Fmember (sequence, found)))
2776 found = Fcons (sequence, found);
2777
2778 /* If firstonly is Qnon_ascii, then we can return the first
2779 binding we find. If firstonly is not Qnon_ascii but not
2780 nil, then we should return the first ascii-only binding
2781 we find. */
2782 if (EQ (firstonly, Qnon_ascii))
2783 RETURN_UNGCPRO (sequence);
2784 else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2785 RETURN_UNGCPRO (sequence);
2786
2787 if (CONSP (remapped))
2788 {
2789 sequence = XCAR (remapped);
2790 remapped = XCDR (remapped);
2791 goto record_sequence;
2792 }
2793 }
2794 }
2795 }
2796
2797 UNGCPRO;
2798
2799 found = Fnreverse (found);
2800
2801 /* firstonly may have been t, but we may have gone all the way through
2802 the keymaps without finding an all-ASCII key sequence. So just
2803 return the best we could find. */
2804 if (!NILP (firstonly))
2805 return Fcar (found);
2806
2807 return found;
2808 }
2809
2810 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2811 doc: /* Return list of keys that invoke DEFINITION.
2812 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2813 If KEYMAP is nil, search all the currently active keymaps.
2814 If KEYMAP is a list of keymaps, search only those keymaps.
2815
2816 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2817 rather than a list of all possible key sequences.
2818 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2819 no matter what it is.
2820 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2821 \(or their meta variants) and entirely reject menu bindings.
2822
2823 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2824 to other keymaps or slots. This makes it possible to search for an
2825 indirect definition itself.
2826
2827 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2828 that invoke a command which is remapped to DEFINITION, but include the
2829 remapped command in the returned list. */)
2830 (definition, keymap, firstonly, noindirect, no_remap)
2831 Lisp_Object definition, keymap;
2832 Lisp_Object firstonly, noindirect, no_remap;
2833 {
2834 Lisp_Object sequences, keymaps;
2835 /* 1 means ignore all menu bindings entirely. */
2836 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2837 Lisp_Object result;
2838
2839 /* Find the relevant keymaps. */
2840 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2841 keymaps = keymap;
2842 else if (!NILP (keymap))
2843 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2844 else
2845 keymaps = Fcurrent_active_maps (Qnil);
2846
2847 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2848 We don't really need to check `keymap'. */
2849 if (nomenus && NILP (noindirect) && NILP (keymap))
2850 {
2851 Lisp_Object *defns;
2852 int i, j, n;
2853 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2854
2855 /* Check heuristic-consistency of the cache. */
2856 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2857 where_is_cache = Qnil;
2858
2859 if (NILP (where_is_cache))
2860 {
2861 /* We need to create the cache. */
2862 Lisp_Object args[2];
2863 where_is_cache = Fmake_hash_table (0, args);
2864 where_is_cache_keymaps = Qt;
2865
2866 /* Fill in the cache. */
2867 GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2868 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2869 UNGCPRO;
2870
2871 where_is_cache_keymaps = keymaps;
2872 }
2873
2874 /* We want to process definitions from the last to the first.
2875 Instead of consing, copy definitions to a vector and step
2876 over that vector. */
2877 sequences = Fgethash (definition, where_is_cache, Qnil);
2878 n = XINT (Flength (sequences));
2879 defns = (Lisp_Object *) alloca (n * sizeof *defns);
2880 for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2881 defns[i++] = XCAR (sequences);
2882
2883 /* Verify that the key bindings are not shadowed. Note that
2884 the following can GC. */
2885 GCPRO2 (definition, keymaps);
2886 result = Qnil;
2887 j = -1;
2888 for (i = n - 1; i >= 0; --i)
2889 if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2890 {
2891 if (ascii_sequence_p (defns[i]))
2892 break;
2893 else if (j < 0)
2894 j = i;
2895 }
2896
2897 result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
2898 UNGCPRO;
2899 }
2900 else
2901 {
2902 /* Kill the cache so that where_is_internal_1 doesn't think
2903 we're filling it up. */
2904 where_is_cache = Qnil;
2905 result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2906 }
2907
2908 return result;
2909 }
2910
2911 /* This is the function that Fwhere_is_internal calls using map_char_table.
2912 ARGS has the form
2913 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2914 .
2915 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2916 Since map_char_table doesn't really use the return value from this function,
2917 we the result append to RESULT, the slot in ARGS.
2918
2919 This function can GC because it calls where_is_internal_1 which can
2920 GC. */
2921
2922 static void
2923 where_is_internal_2 (args, key, binding)
2924 Lisp_Object args, key, binding;
2925 {
2926 Lisp_Object definition, noindirect, this, last;
2927 Lisp_Object result, sequence;
2928 int nomenus, last_is_meta;
2929 struct gcpro gcpro1, gcpro2, gcpro3;
2930
2931 GCPRO3 (args, key, binding);
2932 result = XCDR (XCAR (args));
2933 definition = XCAR (XCAR (XCAR (args)));
2934 noindirect = XCDR (XCAR (XCAR (args)));
2935 this = XCAR (XCAR (XCDR (args)));
2936 last = XCDR (XCAR (XCDR (args)));
2937 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2938 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2939
2940 sequence = where_is_internal_1 (binding, key, definition, noindirect,
2941 this, last, nomenus, last_is_meta);
2942
2943 if (!NILP (sequence))
2944 XSETCDR (XCAR (args), Fcons (sequence, result));
2945
2946 UNGCPRO;
2947 }
2948
2949
2950 /* This function can GC because get_keyelt can. */
2951
2952 static Lisp_Object
2953 where_is_internal_1 (binding, key, definition, noindirect, this, last,
2954 nomenus, last_is_meta)
2955 Lisp_Object binding, key, definition, noindirect, this, last;
2956 int nomenus, last_is_meta;
2957 {
2958 Lisp_Object sequence;
2959
2960 /* Search through indirections unless that's not wanted. */
2961 if (NILP (noindirect))
2962 binding = get_keyelt (binding, 0);
2963
2964 /* End this iteration if this element does not match
2965 the target. */
2966
2967 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2968 || EQ (binding, definition)
2969 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2970 /* Doesn't match. */
2971 return Qnil;
2972
2973 /* We have found a match. Construct the key sequence where we found it. */
2974 if (INTEGERP (key) && last_is_meta)
2975 {
2976 sequence = Fcopy_sequence (this);
2977 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2978 }
2979 else
2980 sequence = append_key (this, key);
2981
2982 if (!NILP (where_is_cache))
2983 {
2984 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2985 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2986 return Qnil;
2987 }
2988 else
2989 return sequence;
2990 }
2991 \f
2992 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2993
2994 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2995 doc: /* Insert the list of all defined keys and their definitions.
2996 The list is inserted in the current buffer, while the bindings are
2997 looked up in BUFFER.
2998 The optional argument PREFIX, if non-nil, should be a key sequence;
2999 then we display only bindings that start with that prefix.
3000 The optional argument MENUS, if non-nil, says to mention menu bindings.
3001 \(Ordinarily these are omitted from the output.) */)
3002 (buffer, prefix, menus)
3003 Lisp_Object buffer, prefix, menus;
3004 {
3005 Lisp_Object outbuf, shadow;
3006 int nomenu = NILP (menus);
3007 register Lisp_Object start1;
3008 struct gcpro gcpro1;
3009
3010 char *alternate_heading
3011 = "\
3012 Keyboard translations:\n\n\
3013 You type Translation\n\
3014 -------- -----------\n";
3015
3016 CHECK_BUFFER (buffer);
3017
3018 shadow = Qnil;
3019 GCPRO1 (shadow);
3020
3021 outbuf = Fcurrent_buffer ();
3022
3023 /* Report on alternates for keys. */
3024 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
3025 {
3026 int c;
3027 const unsigned char *translate = SDATA (Vkeyboard_translate_table);
3028 int translate_len = SCHARS (Vkeyboard_translate_table);
3029
3030 for (c = 0; c < translate_len; c++)
3031 if (translate[c] != c)
3032 {
3033 char buf[KEY_DESCRIPTION_SIZE];
3034 char *bufend;
3035
3036 if (alternate_heading)
3037 {
3038 insert_string (alternate_heading);
3039 alternate_heading = 0;
3040 }
3041
3042 bufend = push_key_description (translate[c], buf, 1);
3043 insert (buf, bufend - buf);
3044 Findent_to (make_number (16), make_number (1));
3045 bufend = push_key_description (c, buf, 1);
3046 insert (buf, bufend - buf);
3047
3048 insert ("\n", 1);
3049
3050 /* Insert calls signal_after_change which may GC. */
3051 translate = SDATA (Vkeyboard_translate_table);
3052 }
3053
3054 insert ("\n", 1);
3055 }
3056
3057 if (!NILP (Vkey_translation_map))
3058 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3059 "Key translations", nomenu, 1, 0, 0);
3060
3061
3062 /* Print the (major mode) local map. */
3063 start1 = Qnil;
3064 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3065 start1 = current_kboard->Voverriding_terminal_local_map;
3066 else if (!NILP (Voverriding_local_map))
3067 start1 = Voverriding_local_map;
3068
3069 if (!NILP (start1))
3070 {
3071 describe_map_tree (start1, 1, shadow, prefix,
3072 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3073 shadow = Fcons (start1, shadow);
3074 }
3075 else
3076 {
3077 /* Print the minor mode and major mode keymaps. */
3078 int i, nmaps;
3079 Lisp_Object *modes, *maps;
3080
3081 /* Temporarily switch to `buffer', so that we can get that buffer's
3082 minor modes correctly. */
3083 Fset_buffer (buffer);
3084
3085 nmaps = current_minor_maps (&modes, &maps);
3086 Fset_buffer (outbuf);
3087
3088 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3089 XBUFFER (buffer), Qkeymap);
3090 if (!NILP (start1))
3091 {
3092 describe_map_tree (start1, 1, shadow, prefix,
3093 "\f\n`keymap' Property Bindings", nomenu,
3094 0, 0, 0);
3095 shadow = Fcons (start1, shadow);
3096 }
3097
3098 /* Print the minor mode maps. */
3099 for (i = 0; i < nmaps; i++)
3100 {
3101 /* The title for a minor mode keymap
3102 is constructed at run time.
3103 We let describe_map_tree do the actual insertion
3104 because it takes care of other features when doing so. */
3105 char *title, *p;
3106
3107 if (!SYMBOLP (modes[i]))
3108 abort();
3109
3110 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3111 *p++ = '\f';
3112 *p++ = '\n';
3113 *p++ = '`';
3114 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3115 SCHARS (SYMBOL_NAME (modes[i])));
3116 p += SCHARS (SYMBOL_NAME (modes[i]));
3117 *p++ = '\'';
3118 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3119 p += sizeof (" Minor Mode Bindings") - 1;
3120 *p = 0;
3121
3122 describe_map_tree (maps[i], 1, shadow, prefix,
3123 title, nomenu, 0, 0, 0);
3124 shadow = Fcons (maps[i], shadow);
3125 }
3126
3127 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3128 XBUFFER (buffer), Qlocal_map);
3129 if (!NILP (start1))
3130 {
3131 if (EQ (start1, XBUFFER (buffer)->keymap))
3132 describe_map_tree (start1, 1, shadow, prefix,
3133 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3134 else
3135 describe_map_tree (start1, 1, shadow, prefix,
3136 "\f\n`local-map' Property Bindings",
3137 nomenu, 0, 0, 0);
3138
3139 shadow = Fcons (start1, shadow);
3140 }
3141 }
3142
3143 describe_map_tree (current_global_map, 1, shadow, prefix,
3144 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3145
3146 /* Print the function-key-map translations under this prefix. */
3147 if (!NILP (Vfunction_key_map))
3148 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
3149 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3150
3151 UNGCPRO;
3152 return Qnil;
3153 }
3154
3155 /* Insert a description of the key bindings in STARTMAP,
3156 followed by those of all maps reachable through STARTMAP.
3157 If PARTIAL is nonzero, omit certain "uninteresting" commands
3158 (such as `undefined').
3159 If SHADOW is non-nil, it is a list of maps;
3160 don't mention keys which would be shadowed by any of them.
3161 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3162 TITLE, if not 0, is a string to insert at the beginning.
3163 TITLE should not end with a colon or a newline; we supply that.
3164 If NOMENU is not 0, then omit menu-bar commands.
3165
3166 If TRANSL is nonzero, the definitions are actually key translations
3167 so print strings and vectors differently.
3168
3169 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3170 to look through.
3171
3172 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3173 don't omit it; instead, mention it but say it is shadowed. */
3174
3175 void
3176 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3177 always_title, mention_shadow)
3178 Lisp_Object startmap, shadow, prefix;
3179 int partial;
3180 char *title;
3181 int nomenu;
3182 int transl;
3183 int always_title;
3184 int mention_shadow;
3185 {
3186 Lisp_Object maps, orig_maps, seen, sub_shadows;
3187 struct gcpro gcpro1, gcpro2, gcpro3;
3188 int something = 0;
3189 char *key_heading
3190 = "\
3191 key binding\n\
3192 --- -------\n";
3193
3194 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3195 seen = Qnil;
3196 sub_shadows = Qnil;
3197 GCPRO3 (maps, seen, sub_shadows);
3198
3199 if (nomenu)
3200 {
3201 Lisp_Object list;
3202
3203 /* Delete from MAPS each element that is for the menu bar. */
3204 for (list = maps; !NILP (list); list = XCDR (list))
3205 {
3206 Lisp_Object elt, prefix, tem;
3207
3208 elt = Fcar (list);
3209 prefix = Fcar (elt);
3210 if (XVECTOR (prefix)->size >= 1)
3211 {
3212 tem = Faref (prefix, make_number (0));
3213 if (EQ (tem, Qmenu_bar))
3214 maps = Fdelq (elt, maps);
3215 }
3216 }
3217 }
3218
3219 if (!NILP (maps) || always_title)
3220 {
3221 if (title)
3222 {
3223 insert_string (title);
3224 if (!NILP (prefix))
3225 {
3226 insert_string (" Starting With ");
3227 insert1 (Fkey_description (prefix, Qnil));
3228 }
3229 insert_string (":\n");
3230 }
3231 insert_string (key_heading);
3232 something = 1;
3233 }
3234
3235 for (; !NILP (maps); maps = Fcdr (maps))
3236 {
3237 register Lisp_Object elt, prefix, tail;
3238
3239 elt = Fcar (maps);
3240 prefix = Fcar (elt);
3241
3242 sub_shadows = Qnil;
3243
3244 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3245 {
3246 Lisp_Object shmap;
3247
3248 shmap = XCAR (tail);
3249
3250 /* If the sequence by which we reach this keymap is zero-length,
3251 then the shadow map for this keymap is just SHADOW. */
3252 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3253 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3254 ;
3255 /* If the sequence by which we reach this keymap actually has
3256 some elements, then the sequence's definition in SHADOW is
3257 what we should use. */
3258 else
3259 {
3260 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3261 if (INTEGERP (shmap))
3262 shmap = Qnil;
3263 }
3264
3265 /* If shmap is not nil and not a keymap,
3266 it completely shadows this map, so don't
3267 describe this map at all. */
3268 if (!NILP (shmap) && !KEYMAPP (shmap))
3269 goto skip;
3270
3271 if (!NILP (shmap))
3272 sub_shadows = Fcons (shmap, sub_shadows);
3273 }
3274
3275 /* Maps we have already listed in this loop shadow this map. */
3276 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3277 {
3278 Lisp_Object tem;
3279 tem = Fequal (Fcar (XCAR (tail)), prefix);
3280 if (!NILP (tem))
3281 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3282 }
3283
3284 describe_map (Fcdr (elt), prefix,
3285 transl ? describe_translation : describe_command,
3286 partial, sub_shadows, &seen, nomenu, mention_shadow);
3287
3288 skip: ;
3289 }
3290
3291 if (something)
3292 insert_string ("\n");
3293
3294 UNGCPRO;
3295 }
3296
3297 static int previous_description_column;
3298
3299 static void
3300 describe_command (definition, args)
3301 Lisp_Object definition, args;
3302 {
3303 register Lisp_Object tem1;
3304 int column = (int) current_column (); /* iftc */
3305 int description_column;
3306
3307 /* If column 16 is no good, go to col 32;
3308 but don't push beyond that--go to next line instead. */
3309 if (column > 30)
3310 {
3311 insert_char ('\n');
3312 description_column = 32;
3313 }
3314 else if (column > 14 || (column > 10 && previous_description_column == 32))
3315 description_column = 32;
3316 else
3317 description_column = 16;
3318
3319 Findent_to (make_number (description_column), make_number (1));
3320 previous_description_column = description_column;
3321
3322 if (SYMBOLP (definition))
3323 {
3324 tem1 = SYMBOL_NAME (definition);
3325 insert1 (tem1);
3326 insert_string ("\n");
3327 }
3328 else if (STRINGP (definition) || VECTORP (definition))
3329 insert_string ("Keyboard Macro\n");
3330 else if (KEYMAPP (definition))
3331 insert_string ("Prefix Command\n");
3332 else
3333 insert_string ("??\n");
3334 }
3335
3336 static void
3337 describe_translation (definition, args)
3338 Lisp_Object definition, args;
3339 {
3340 register Lisp_Object tem1;
3341
3342 Findent_to (make_number (16), make_number (1));
3343
3344 if (SYMBOLP (definition))
3345 {
3346 tem1 = SYMBOL_NAME (definition);
3347 insert1 (tem1);
3348 insert_string ("\n");
3349 }
3350 else if (STRINGP (definition) || VECTORP (definition))
3351 {
3352 insert1 (Fkey_description (definition, Qnil));
3353 insert_string ("\n");
3354 }
3355 else if (KEYMAPP (definition))
3356 insert_string ("Prefix Command\n");
3357 else
3358 insert_string ("??\n");
3359 }
3360
3361 /* describe_map puts all the usable elements of a sparse keymap
3362 into an array of `struct describe_map_elt',
3363 then sorts them by the events. */
3364
3365 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3366
3367 /* qsort comparison function for sorting `struct describe_map_elt' by
3368 the event field. */
3369
3370 static int
3371 describe_map_compare (aa, bb)
3372 const void *aa, *bb;
3373 {
3374 const struct describe_map_elt *a = aa, *b = bb;
3375 if (INTEGERP (a->event) && INTEGERP (b->event))
3376 return ((XINT (a->event) > XINT (b->event))
3377 - (XINT (a->event) < XINT (b->event)));
3378 if (!INTEGERP (a->event) && INTEGERP (b->event))
3379 return 1;
3380 if (INTEGERP (a->event) && !INTEGERP (b->event))
3381 return -1;
3382 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3383 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3384 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3385 : 0);
3386 return 0;
3387 }
3388
3389 /* Describe the contents of map MAP, assuming that this map itself is
3390 reached by the sequence of prefix keys PREFIX (a string or vector).
3391 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3392
3393 static void
3394 describe_map (map, prefix, elt_describer, partial, shadow,
3395 seen, nomenu, mention_shadow)
3396 register Lisp_Object map;
3397 Lisp_Object prefix;
3398 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3399 int partial;
3400 Lisp_Object shadow;
3401 Lisp_Object *seen;
3402 int nomenu;
3403 int mention_shadow;
3404 {
3405 Lisp_Object tail, definition, event;
3406 Lisp_Object tem;
3407 Lisp_Object suppress;
3408 Lisp_Object kludge;
3409 int first = 1;
3410 struct gcpro gcpro1, gcpro2, gcpro3;
3411
3412 /* These accumulate the values from sparse keymap bindings,
3413 so we can sort them and handle them in order. */
3414 int length_needed = 0;
3415 struct describe_map_elt *vect;
3416 int slots_used = 0;
3417 int i;
3418
3419 suppress = Qnil;
3420
3421 if (partial)
3422 suppress = intern ("suppress-keymap");
3423
3424 /* This vector gets used to present single keys to Flookup_key. Since
3425 that is done once per keymap element, we don't want to cons up a
3426 fresh vector every time. */
3427 kludge = Fmake_vector (make_number (1), Qnil);
3428 definition = Qnil;
3429
3430 for (tail = map; CONSP (tail); tail = XCDR (tail))
3431 length_needed++;
3432
3433 vect = ((struct describe_map_elt *)
3434 alloca (sizeof (struct describe_map_elt) * length_needed));
3435
3436 GCPRO3 (prefix, definition, kludge);
3437
3438 for (tail = map; CONSP (tail); tail = XCDR (tail))
3439 {
3440 QUIT;
3441
3442 if (VECTORP (XCAR (tail))
3443 || CHAR_TABLE_P (XCAR (tail)))
3444 describe_vector (XCAR (tail),
3445 prefix, Qnil, elt_describer, partial, shadow, map,
3446 (int *)0, 0, 1, mention_shadow);
3447 else if (CONSP (XCAR (tail)))
3448 {
3449 int this_shadowed = 0;
3450
3451 event = XCAR (XCAR (tail));
3452
3453 /* Ignore bindings whose "prefix" are not really valid events.
3454 (We get these in the frames and buffers menu.) */
3455 if (!(SYMBOLP (event) || INTEGERP (event)))
3456 continue;
3457
3458 if (nomenu && EQ (event, Qmenu_bar))
3459 continue;
3460
3461 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3462
3463 /* Don't show undefined commands or suppressed commands. */
3464 if (NILP (definition)) continue;
3465 if (SYMBOLP (definition) && partial)
3466 {
3467 tem = Fget (definition, suppress);
3468 if (!NILP (tem))
3469 continue;
3470 }
3471
3472 /* Don't show a command that isn't really visible
3473 because a local definition of the same key shadows it. */
3474
3475 ASET (kludge, 0, event);
3476 if (!NILP (shadow))
3477 {
3478 tem = shadow_lookup (shadow, kludge, Qt);
3479 if (!NILP (tem))
3480 {
3481 /* If both bindings are keymaps, this key is a prefix key,
3482 so don't say it is shadowed. */
3483 if (KEYMAPP (definition) && KEYMAPP (tem))
3484 ;
3485 /* Avoid generating duplicate entries if the
3486 shadowed binding has the same definition. */
3487 else if (mention_shadow && !EQ (tem, definition))
3488 this_shadowed = 1;
3489 else
3490 continue;
3491 }
3492 }
3493
3494 tem = Flookup_key (map, kludge, Qt);
3495 if (!EQ (tem, definition)) continue;
3496
3497 vect[slots_used].event = event;
3498 vect[slots_used].definition = definition;
3499 vect[slots_used].shadowed = this_shadowed;
3500 slots_used++;
3501 }
3502 else if (EQ (XCAR (tail), Qkeymap))
3503 {
3504 /* The same keymap might be in the structure twice, if we're
3505 using an inherited keymap. So skip anything we've already
3506 encountered. */
3507 tem = Fassq (tail, *seen);
3508 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3509 break;
3510 *seen = Fcons (Fcons (tail, prefix), *seen);
3511 }
3512 }
3513
3514 /* If we found some sparse map events, sort them. */
3515
3516 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3517 describe_map_compare);
3518
3519 /* Now output them in sorted order. */
3520
3521 for (i = 0; i < slots_used; i++)
3522 {
3523 Lisp_Object start, end;
3524
3525 if (first)
3526 {
3527 previous_description_column = 0;
3528 insert ("\n", 1);
3529 first = 0;
3530 }
3531
3532 ASET (kludge, 0, vect[i].event);
3533 start = vect[i].event;
3534 end = start;
3535
3536 definition = vect[i].definition;
3537
3538 /* Find consecutive chars that are identically defined. */
3539 if (INTEGERP (vect[i].event))
3540 {
3541 while (i + 1 < slots_used
3542 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3543 && !NILP (Fequal (vect[i + 1].definition, definition))
3544 && vect[i].shadowed == vect[i + 1].shadowed)
3545 i++;
3546 end = vect[i].event;
3547 }
3548
3549 /* Now START .. END is the range to describe next. */
3550
3551 /* Insert the string to describe the event START. */
3552 insert1 (Fkey_description (kludge, prefix));
3553
3554 if (!EQ (start, end))
3555 {
3556 insert (" .. ", 4);
3557
3558 ASET (kludge, 0, end);
3559 /* Insert the string to describe the character END. */
3560 insert1 (Fkey_description (kludge, prefix));
3561 }
3562
3563 /* Print a description of the definition of this character.
3564 elt_describer will take care of spacing out far enough
3565 for alignment purposes. */
3566 (*elt_describer) (vect[i].definition, Qnil);
3567
3568 if (vect[i].shadowed)
3569 {
3570 SET_PT (PT - 1);
3571 insert_string ("\n (that binding is currently shadowed by another mode)");
3572 SET_PT (PT + 1);
3573 }
3574 }
3575
3576 UNGCPRO;
3577 }
3578
3579 static void
3580 describe_vector_princ (elt, fun)
3581 Lisp_Object elt, fun;
3582 {
3583 Findent_to (make_number (16), make_number (1));
3584 call1 (fun, elt);
3585 Fterpri (Qnil);
3586 }
3587
3588 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3589 doc: /* Insert a description of contents of VECTOR.
3590 This is text showing the elements of vector matched against indices.
3591 DESCRIBER is the output function used; nil means use `princ'. */)
3592 (vector, describer)
3593 Lisp_Object vector, describer;
3594 {
3595 int count = SPECPDL_INDEX ();
3596 if (NILP (describer))
3597 describer = intern ("princ");
3598 specbind (Qstandard_output, Fcurrent_buffer ());
3599 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3600 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3601 Qnil, Qnil, (int *)0, 0, 0, 0);
3602
3603 return unbind_to (count, Qnil);
3604 }
3605
3606 /* Insert in the current buffer a description of the contents of VECTOR.
3607 We call ELT_DESCRIBER to insert the description of one value found
3608 in VECTOR.
3609
3610 ELT_PREFIX describes what "comes before" the keys or indices defined
3611 by this vector. This is a human-readable string whose size
3612 is not necessarily related to the situation.
3613
3614 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3615 leads to this keymap.
3616
3617 If the vector is a chartable, ELT_PREFIX is the vector
3618 of bytes that lead to the character set or portion of a character
3619 set described by this chartable.
3620
3621 If PARTIAL is nonzero, it means do not mention suppressed commands
3622 (that assumes the vector is in a keymap).
3623
3624 SHADOW is a list of keymaps that shadow this map.
3625 If it is non-nil, then we look up the key in those maps
3626 and we don't mention it now if it is defined by any of them.
3627
3628 ENTIRE_MAP is the keymap in which this vector appears.
3629 If the definition in effect in the whole map does not match
3630 the one in this vector, we ignore this one.
3631
3632 When describing a sub-char-table, INDICES is a list of
3633 indices at higher levels in this char-table,
3634 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3635
3636 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3637
3638 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3639
3640 static void
3641 describe_vector (vector, prefix, args, elt_describer,
3642 partial, shadow, entire_map,
3643 indices, char_table_depth, keymap_p,
3644 mention_shadow)
3645 register Lisp_Object vector;
3646 Lisp_Object prefix, args;
3647 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3648 int partial;
3649 Lisp_Object shadow;
3650 Lisp_Object entire_map;
3651 int *indices;
3652 int char_table_depth;
3653 int keymap_p;
3654 int mention_shadow;
3655 {
3656 Lisp_Object definition;
3657 Lisp_Object tem2;
3658 Lisp_Object elt_prefix = Qnil;
3659 register int i;
3660 Lisp_Object suppress;
3661 Lisp_Object kludge;
3662 int first = 1;
3663 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3664 /* Range of elements to be handled. */
3665 int from, to;
3666 /* A flag to tell if a leaf in this level of char-table is not a
3667 generic character (i.e. a complete multibyte character). */
3668 int complete_char;
3669 int character;
3670 int starting_i;
3671
3672 suppress = Qnil;
3673
3674 if (indices == 0)
3675 indices = (int *) alloca (3 * sizeof (int));
3676
3677 definition = Qnil;
3678
3679 if (!keymap_p)
3680 {
3681 /* Call Fkey_description first, to avoid GC bug for the other string. */
3682 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3683 {
3684 Lisp_Object tem;
3685 tem = Fkey_description (prefix, Qnil);
3686 elt_prefix = concat2 (tem, build_string (" "));
3687 }
3688 prefix = Qnil;
3689 }
3690
3691 /* This vector gets used to present single keys to Flookup_key. Since
3692 that is done once per vector element, we don't want to cons up a
3693 fresh vector every time. */
3694 kludge = Fmake_vector (make_number (1), Qnil);
3695 GCPRO4 (elt_prefix, prefix, definition, kludge);
3696
3697 if (partial)
3698 suppress = intern ("suppress-keymap");
3699
3700 if (CHAR_TABLE_P (vector))
3701 {
3702 if (char_table_depth == 0)
3703 {
3704 /* VECTOR is a top level char-table. */
3705 complete_char = 1;
3706 from = 0;
3707 to = CHAR_TABLE_ORDINARY_SLOTS;
3708 }
3709 else
3710 {
3711 /* VECTOR is a sub char-table. */
3712 if (char_table_depth >= 3)
3713 /* A char-table is never that deep. */
3714 error ("Too deep char table");
3715
3716 complete_char
3717 = (CHARSET_VALID_P (indices[0])
3718 && ((CHARSET_DIMENSION (indices[0]) == 1
3719 && char_table_depth == 1)
3720 || char_table_depth == 2));
3721
3722 /* Meaningful elements are from 32th to 127th. */
3723 from = 32;
3724 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3725 }
3726 }
3727 else
3728 {
3729 /* This does the right thing for ordinary vectors. */
3730
3731 complete_char = 1;
3732 from = 0;
3733 to = XVECTOR (vector)->size;
3734 }
3735
3736 for (i = from; i < to; i++)
3737 {
3738 int this_shadowed = 0;
3739 QUIT;
3740
3741 if (CHAR_TABLE_P (vector))
3742 {
3743 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3744 complete_char = 0;
3745
3746 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3747 && !CHARSET_DEFINED_P (i - 128))
3748 continue;
3749
3750 definition
3751 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3752 }
3753 else
3754 definition = get_keyelt (AREF (vector, i), 0);
3755
3756 if (NILP (definition)) continue;
3757
3758 /* Don't mention suppressed commands. */
3759 if (SYMBOLP (definition) && partial)
3760 {
3761 Lisp_Object tem;
3762
3763 tem = Fget (definition, suppress);
3764
3765 if (!NILP (tem)) continue;
3766 }
3767
3768 /* Set CHARACTER to the character this entry describes, if any.
3769 Also update *INDICES. */
3770 if (CHAR_TABLE_P (vector))
3771 {
3772 indices[char_table_depth] = i;
3773
3774 if (char_table_depth == 0)
3775 {
3776 character = i;
3777 indices[0] = i - 128;
3778 }
3779 else if (complete_char)
3780 {
3781 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3782 }
3783 else
3784 character = 0;
3785 }
3786 else
3787 character = i;
3788
3789 ASET (kludge, 0, make_number (character));
3790
3791 /* If this binding is shadowed by some other map, ignore it. */
3792 if (!NILP (shadow) && complete_char)
3793 {
3794 Lisp_Object tem;
3795
3796 tem = shadow_lookup (shadow, kludge, Qt);
3797
3798 if (!NILP (tem))
3799 {
3800 if (mention_shadow)
3801 this_shadowed = 1;
3802 else
3803 continue;
3804 }
3805 }
3806
3807 /* Ignore this definition if it is shadowed by an earlier
3808 one in the same keymap. */
3809 if (!NILP (entire_map) && complete_char)
3810 {
3811 Lisp_Object tem;
3812
3813 tem = Flookup_key (entire_map, kludge, Qt);
3814
3815 if (!EQ (tem, definition))
3816 continue;
3817 }
3818
3819 if (first)
3820 {
3821 if (char_table_depth == 0)
3822 insert ("\n", 1);
3823 first = 0;
3824 }
3825
3826 /* For a sub char-table, show the depth by indentation.
3827 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3828 if (char_table_depth > 0)
3829 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3830
3831 /* Output the prefix that applies to every entry in this map. */
3832 if (!NILP (elt_prefix))
3833 insert1 (elt_prefix);
3834
3835 /* Insert or describe the character this slot is for,
3836 or a description of what it is for. */
3837 if (SUB_CHAR_TABLE_P (vector))
3838 {
3839 if (complete_char)
3840 insert_char (character);
3841 else
3842 {
3843 /* We need an octal representation for this block of
3844 characters. */
3845 char work[16];
3846 sprintf (work, "(row %d)", i);
3847 insert (work, strlen (work));
3848 }
3849 }
3850 else if (CHAR_TABLE_P (vector))
3851 {
3852 if (complete_char)
3853 insert1 (Fkey_description (kludge, prefix));
3854 else
3855 {
3856 /* Print the information for this character set. */
3857 insert_string ("<");
3858 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3859 if (STRINGP (tem2))
3860 insert_from_string (tem2, 0, 0, SCHARS (tem2),
3861 SBYTES (tem2), 0);
3862 else
3863 insert ("?", 1);
3864 insert (">", 1);
3865 }
3866 }
3867 else
3868 {
3869 insert1 (Fkey_description (kludge, prefix));
3870 }
3871
3872 /* If we find a sub char-table within a char-table,
3873 scan it recursively; it defines the details for
3874 a character set or a portion of a character set. */
3875 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3876 {
3877 insert ("\n", 1);
3878 describe_vector (definition, prefix, args, elt_describer,
3879 partial, shadow, entire_map,
3880 indices, char_table_depth + 1, keymap_p,
3881 mention_shadow);
3882 continue;
3883 }
3884
3885 starting_i = i;
3886
3887 /* Find all consecutive characters or rows that have the same
3888 definition. But, for elements of a top level char table, if
3889 they are for charsets, we had better describe one by one even
3890 if they have the same definition. */
3891 if (CHAR_TABLE_P (vector))
3892 {
3893 int limit = to;
3894
3895 if (char_table_depth == 0)
3896 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3897
3898 while (i + 1 < limit
3899 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3900 !NILP (tem2))
3901 && !NILP (Fequal (tem2, definition)))
3902 i++;
3903 }
3904 else
3905 while (i + 1 < to
3906 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3907 !NILP (tem2))
3908 && !NILP (Fequal (tem2, definition)))
3909 i++;
3910
3911
3912 /* If we have a range of more than one character,
3913 print where the range reaches to. */
3914
3915 if (i != starting_i)
3916 {
3917 insert (" .. ", 4);
3918
3919 ASET (kludge, 0, make_number (i));
3920
3921 if (!NILP (elt_prefix))
3922 insert1 (elt_prefix);
3923
3924 if (CHAR_TABLE_P (vector))
3925 {
3926 if (char_table_depth == 0)
3927 {
3928 insert1 (Fkey_description (kludge, prefix));
3929 }
3930 else if (complete_char)
3931 {
3932 indices[char_table_depth] = i;
3933 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3934 insert_char (character);
3935 }
3936 else
3937 {
3938 /* We need an octal representation for this block of
3939 characters. */
3940 char work[16];
3941 sprintf (work, "(row %d)", i);
3942 insert (work, strlen (work));
3943 }
3944 }
3945 else
3946 {
3947 insert1 (Fkey_description (kludge, prefix));
3948 }
3949 }
3950
3951 /* Print a description of the definition of this character.
3952 elt_describer will take care of spacing out far enough
3953 for alignment purposes. */
3954 (*elt_describer) (definition, args);
3955
3956 if (this_shadowed)
3957 {
3958 SET_PT (PT - 1);
3959 insert_string (" (binding currently shadowed)");
3960 SET_PT (PT + 1);
3961 }
3962 }
3963
3964 /* For (sub) char-table, print `defalt' slot at last. */
3965 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3966 {
3967 insert (" ", char_table_depth * 2);
3968 insert_string ("<<default>>");
3969 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3970 }
3971
3972 UNGCPRO;
3973 }
3974 \f
3975 /* Apropos - finding all symbols whose names match a regexp. */
3976 static Lisp_Object apropos_predicate;
3977 static Lisp_Object apropos_accumulate;
3978
3979 static void
3980 apropos_accum (symbol, string)
3981 Lisp_Object symbol, string;
3982 {
3983 register Lisp_Object tem;
3984
3985 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3986 if (!NILP (tem) && !NILP (apropos_predicate))
3987 tem = call1 (apropos_predicate, symbol);
3988 if (!NILP (tem))
3989 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3990 }
3991
3992 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3993 doc: /* Show all symbols whose names contain match for REGEXP.
3994 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3995 for each symbol and a symbol is mentioned only if that returns non-nil.
3996 Return list of symbols found. */)
3997 (regexp, predicate)
3998 Lisp_Object regexp, predicate;
3999 {
4000 Lisp_Object tem;
4001 CHECK_STRING (regexp);
4002 apropos_predicate = predicate;
4003 apropos_accumulate = Qnil;
4004 map_obarray (Vobarray, apropos_accum, regexp);
4005 tem = Fsort (apropos_accumulate, Qstring_lessp);
4006 apropos_accumulate = Qnil;
4007 apropos_predicate = Qnil;
4008 return tem;
4009 }
4010 \f
4011 void
4012 syms_of_keymap ()
4013 {
4014 Qkeymap = intern ("keymap");
4015 staticpro (&Qkeymap);
4016 staticpro (&apropos_predicate);
4017 staticpro (&apropos_accumulate);
4018 apropos_predicate = Qnil;
4019 apropos_accumulate = Qnil;
4020
4021 /* Now we are ready to set up this property, so we can
4022 create char tables. */
4023 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
4024
4025 /* Initialize the keymaps standardly used.
4026 Each one is the value of a Lisp variable, and is also
4027 pointed to by a C variable */
4028
4029 global_map = Fmake_keymap (Qnil);
4030 Fset (intern ("global-map"), global_map);
4031
4032 current_global_map = global_map;
4033 staticpro (&global_map);
4034 staticpro (&current_global_map);
4035
4036 meta_map = Fmake_keymap (Qnil);
4037 Fset (intern ("esc-map"), meta_map);
4038 Ffset (intern ("ESC-prefix"), meta_map);
4039
4040 control_x_map = Fmake_keymap (Qnil);
4041 Fset (intern ("ctl-x-map"), control_x_map);
4042 Ffset (intern ("Control-X-prefix"), control_x_map);
4043
4044 exclude_keys
4045 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
4046 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
4047 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
4048 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
4049 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
4050 Qnil)))));
4051 staticpro (&exclude_keys);
4052
4053 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
4054 doc: /* List of commands given new key bindings recently.
4055 This is used for internal purposes during Emacs startup;
4056 don't alter it yourself. */);
4057 Vdefine_key_rebound_commands = Qt;
4058
4059 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
4060 doc: /* Default keymap to use when reading from the minibuffer. */);
4061 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
4062
4063 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
4064 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
4065 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
4066 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
4067
4068 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
4069 doc: /* Local keymap for minibuffer input with completion. */);
4070 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
4071 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
4072
4073 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
4074 &Vminibuffer_local_filename_completion_map,
4075 doc: /* Local keymap for minibuffer input with completion for filenames. */);
4076 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
4077 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
4078 Vminibuffer_local_completion_map);
4079
4080
4081 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
4082 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
4083 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
4084 Fset_keymap_parent (Vminibuffer_local_must_match_map,
4085 Vminibuffer_local_completion_map);
4086
4087 DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
4088 &Vminibuffer_local_must_match_filename_map,
4089 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
4090 Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
4091 Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
4092 Vminibuffer_local_must_match_map);
4093
4094 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4095 doc: /* Alist of keymaps to use for minor modes.
4096 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4097 key sequences and look up bindings iff VARIABLE's value is non-nil.
4098 If two active keymaps bind the same key, the keymap appearing earlier
4099 in the list takes precedence. */);
4100 Vminor_mode_map_alist = Qnil;
4101
4102 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4103 doc: /* Alist of keymaps to use for minor modes, in current major mode.
4104 This variable is an alist just like `minor-mode-map-alist', and it is
4105 used the same way (and before `minor-mode-map-alist'); however,
4106 it is provided for major modes to bind locally. */);
4107 Vminor_mode_overriding_map_alist = Qnil;
4108
4109 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4110 doc: /* List of keymap alists to use for emulations modes.
4111 It is intended for modes or packages using multiple minor-mode keymaps.
4112 Each element is a keymap alist just like `minor-mode-map-alist', or a
4113 symbol with a variable binding which is a keymap alist, and it is used
4114 the same way. The "active" keymaps in each alist are used before
4115 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
4116 Vemulation_mode_map_alists = Qnil;
4117
4118
4119 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
4120 doc: /* Keymap that translates key sequences to key sequences during input.
4121 This is used mainly for mapping ASCII function key sequences into
4122 real Emacs function key events (symbols).
4123
4124 The `read-key-sequence' function replaces any subsequence bound by
4125 `function-key-map' with its binding. More precisely, when the active
4126 keymaps have no binding for the current key sequence but
4127 `function-key-map' binds a suffix of the sequence to a vector or string,
4128 `read-key-sequence' replaces the matching suffix with its binding, and
4129 continues with the new sequence.
4130
4131 If the binding is a function, it is called with one argument (the prompt)
4132 and its return value (a key sequence) is used.
4133
4134 The events that come from bindings in `function-key-map' are not
4135 themselves looked up in `function-key-map'.
4136
4137 For example, suppose `function-key-map' binds `ESC O P' to [f1].
4138 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
4139 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
4140 key, typing `ESC O P x' would return [f1 x]. */);
4141 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
4142
4143 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
4144 doc: /* Keymap of key translations that can override keymaps.
4145 This keymap works like `function-key-map', but comes after that,
4146 and its non-prefix bindings override ordinary bindings. */);
4147 Vkey_translation_map = Qnil;
4148
4149 staticpro (&Vmouse_events);
4150 Vmouse_events = Fcons (intern ("menu-bar"),
4151 Fcons (intern ("tool-bar"),
4152 Fcons (intern ("header-line"),
4153 Fcons (intern ("mode-line"),
4154 Fcons (intern ("mouse-1"),
4155 Fcons (intern ("mouse-2"),
4156 Fcons (intern ("mouse-3"),
4157 Fcons (intern ("mouse-4"),
4158 Fcons (intern ("mouse-5"),
4159 Qnil)))))))));
4160
4161
4162 Qsingle_key_description = intern ("single-key-description");
4163 staticpro (&Qsingle_key_description);
4164
4165 Qkey_description = intern ("key-description");
4166 staticpro (&Qkey_description);
4167
4168 Qkeymapp = intern ("keymapp");
4169 staticpro (&Qkeymapp);
4170
4171 Qnon_ascii = intern ("non-ascii");
4172 staticpro (&Qnon_ascii);
4173
4174 Qmenu_item = intern ("menu-item");
4175 staticpro (&Qmenu_item);
4176
4177 Qremap = intern ("remap");
4178 staticpro (&Qremap);
4179
4180 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4181 staticpro (&command_remapping_vector);
4182
4183 where_is_cache_keymaps = Qt;
4184 where_is_cache = Qnil;
4185 staticpro (&where_is_cache);
4186 staticpro (&where_is_cache_keymaps);
4187
4188 defsubr (&Skeymapp);
4189 defsubr (&Skeymap_parent);
4190 defsubr (&Skeymap_prompt);
4191 defsubr (&Sset_keymap_parent);
4192 defsubr (&Smake_keymap);
4193 defsubr (&Smake_sparse_keymap);
4194 defsubr (&Smap_keymap);
4195 defsubr (&Scopy_keymap);
4196 defsubr (&Scommand_remapping);
4197 defsubr (&Skey_binding);
4198 defsubr (&Slocal_key_binding);
4199 defsubr (&Sglobal_key_binding);
4200 defsubr (&Sminor_mode_key_binding);
4201 defsubr (&Sdefine_key);
4202 defsubr (&Slookup_key);
4203 defsubr (&Sdefine_prefix_command);
4204 defsubr (&Suse_global_map);
4205 defsubr (&Suse_local_map);
4206 defsubr (&Scurrent_local_map);
4207 defsubr (&Scurrent_global_map);
4208 defsubr (&Scurrent_minor_mode_maps);
4209 defsubr (&Scurrent_active_maps);
4210 defsubr (&Saccessible_keymaps);
4211 defsubr (&Skey_description);
4212 defsubr (&Sdescribe_vector);
4213 defsubr (&Ssingle_key_description);
4214 defsubr (&Stext_char_description);
4215 defsubr (&Swhere_is_internal);
4216 defsubr (&Sdescribe_buffer_bindings);
4217 defsubr (&Sapropos_internal);
4218 }
4219
4220 void
4221 keys_of_keymap ()
4222 {
4223 initial_define_key (global_map, 033, "ESC-prefix");
4224 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
4225 }
4226
4227 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4228 (do not change this comment) */