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