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 3, 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 int 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 int 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 int 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, 2, 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'. POSITION can specify a click position
1541 like in the respective argument of `key-binding'. */)
1542 (olp, position)
1543 Lisp_Object olp, position;
1544 {
1545 int count = SPECPDL_INDEX ();
1546
1547 Lisp_Object keymaps;
1548
1549 /* If a mouse click position is given, our variables are based on
1550 the buffer clicked on, not the current buffer. So we may have to
1551 switch the buffer here. */
1552
1553 if (CONSP (position))
1554 {
1555 Lisp_Object window;
1556
1557 window = POSN_WINDOW (position);
1558
1559 if (WINDOWP (window)
1560 && BUFFERP (XWINDOW (window)->buffer)
1561 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1562 {
1563 /* Arrange to go back to the original buffer once we're done
1564 processing the key sequence. We don't use
1565 save_excursion_{save,restore} here, in analogy to
1566 `read-key-sequence' to avoid saving point. Maybe this
1567 would not be a problem here, but it is easier to keep
1568 things the same.
1569 */
1570
1571 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1572
1573 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1574 }
1575 }
1576
1577 keymaps = Fcons (current_global_map, Qnil);
1578
1579 if (!NILP (olp))
1580 {
1581 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1582 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1583 /* The doc said that overriding-terminal-local-map should
1584 override overriding-local-map. The code used them both,
1585 but it seems clearer to use just one. rms, jan 2005. */
1586 else if (!NILP (Voverriding_local_map))
1587 keymaps = Fcons (Voverriding_local_map, keymaps);
1588 }
1589 if (NILP (XCDR (keymaps)))
1590 {
1591 Lisp_Object *maps;
1592 int nmaps, i;
1593
1594 Lisp_Object keymap, local_map;
1595 EMACS_INT pt;
1596
1597 pt = INTEGERP (position) ? XINT (position)
1598 : MARKERP (position) ? marker_position (position)
1599 : PT;
1600
1601 /* Get the buffer local maps, possibly overriden by text or
1602 overlay properties */
1603
1604 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1605 keymap = get_local_map (pt, current_buffer, Qkeymap);
1606
1607 if (CONSP (position))
1608 {
1609 Lisp_Object string;
1610
1611 /* For a mouse click, get the local text-property keymap
1612 of the place clicked on, rather than point. */
1613
1614 if (POSN_INBUFFER_P (position))
1615 {
1616 Lisp_Object pos;
1617
1618 pos = POSN_BUFFER_POSN (position);
1619 if (INTEGERP (pos)
1620 && XINT (pos) >= BEG && XINT (pos) <= Z)
1621 {
1622 local_map = get_local_map (XINT (pos),
1623 current_buffer, Qlocal_map);
1624
1625 keymap = get_local_map (XINT (pos),
1626 current_buffer, Qkeymap);
1627 }
1628 }
1629
1630 /* If on a mode line string with a local keymap,
1631 or for a click on a string, i.e. overlay string or a
1632 string displayed via the `display' property,
1633 consider `local-map' and `keymap' properties of
1634 that string. */
1635
1636 if (string = POSN_STRING (position),
1637 (CONSP (string) && STRINGP (XCAR (string))))
1638 {
1639 Lisp_Object pos, map;
1640
1641 pos = XCDR (string);
1642 string = XCAR (string);
1643 if (INTEGERP (pos)
1644 && XINT (pos) >= 0
1645 && XINT (pos) < SCHARS (string))
1646 {
1647 map = Fget_text_property (pos, Qlocal_map, string);
1648 if (!NILP (map))
1649 local_map = map;
1650
1651 map = Fget_text_property (pos, Qkeymap, string);
1652 if (!NILP (map))
1653 keymap = map;
1654 }
1655 }
1656
1657 }
1658
1659 if (!NILP (local_map))
1660 keymaps = Fcons (local_map, keymaps);
1661
1662 /* Now put all the minor mode keymaps on the list. */
1663 nmaps = current_minor_maps (0, &maps);
1664
1665 for (i = --nmaps; i >= 0; i--)
1666 if (!NILP (maps[i]))
1667 keymaps = Fcons (maps[i], keymaps);
1668
1669 if (!NILP (keymap))
1670 keymaps = Fcons (keymap, keymaps);
1671 }
1672
1673 unbind_to (count, Qnil);
1674
1675 return keymaps;
1676 }
1677
1678 /* GC is possible in this function if it autoloads a keymap. */
1679
1680 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1681 doc: /* Return the binding for command KEY in current keymaps.
1682 KEY is a string or vector, a sequence of keystrokes.
1683 The binding is probably a symbol with a function definition.
1684
1685 Normally, `key-binding' ignores bindings for t, which act as default
1686 bindings, used when nothing else in the keymap applies; this makes it
1687 usable as a general function for probing keymaps. However, if the
1688 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1689 recognize the default bindings, just as `read-key-sequence' does.
1690
1691 Like the normal command loop, `key-binding' will remap the command
1692 resulting from looking up KEY by looking up the command in the
1693 current keymaps. However, if the optional third argument NO-REMAP
1694 is non-nil, `key-binding' returns the unmapped command.
1695
1696 If KEY is a key sequence initiated with the mouse, the used keymaps
1697 will depend on the clicked mouse position with regard to the buffer
1698 and possible local keymaps on strings.
1699
1700 If the optional argument POSITION is non-nil, it specifies a mouse
1701 position as returned by `event-start' and `event-end', and the lookup
1702 occurs in the keymaps associated with it instead of KEY. It can also
1703 be a number or marker, in which case the keymap properties at the
1704 specified buffer position instead of point are used.
1705 */)
1706 (key, accept_default, no_remap, position)
1707 Lisp_Object key, accept_default, no_remap, position;
1708 {
1709 Lisp_Object *maps, value;
1710 int nmaps, i;
1711 struct gcpro gcpro1, gcpro2;
1712 int count = SPECPDL_INDEX ();
1713
1714 GCPRO2 (key, position);
1715
1716 if (NILP (position) && VECTORP (key))
1717 {
1718 Lisp_Object event
1719 /* mouse events may have a symbolic prefix indicating the
1720 scrollbar or mode line */
1721 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1722
1723 /* We are not interested in locations without event data */
1724
1725 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1726 {
1727 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1728 if (EQ (kind, Qmouse_click))
1729 position = EVENT_START (event);
1730 }
1731 }
1732
1733 /* Key sequences beginning with mouse clicks
1734 are read using the keymaps of the buffer clicked on, not
1735 the current buffer. So we may have to switch the buffer
1736 here. */
1737
1738 if (CONSP (position))
1739 {
1740 Lisp_Object window;
1741
1742 window = POSN_WINDOW (position);
1743
1744 if (WINDOWP (window)
1745 && BUFFERP (XWINDOW (window)->buffer)
1746 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1747 {
1748 /* Arrange to go back to the original buffer once we're done
1749 processing the key sequence. We don't use
1750 save_excursion_{save,restore} here, in analogy to
1751 `read-key-sequence' to avoid saving point. Maybe this
1752 would not be a problem here, but it is easier to keep
1753 things the same.
1754 */
1755
1756 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1757
1758 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1759 }
1760 }
1761
1762 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1763 {
1764 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1765 key, accept_default);
1766 if (! NILP (value) && !INTEGERP (value))
1767 goto done;
1768 }
1769 else if (! NILP (Voverriding_local_map))
1770 {
1771 value = Flookup_key (Voverriding_local_map, key, accept_default);
1772 if (! NILP (value) && !INTEGERP (value))
1773 goto done;
1774 }
1775 else
1776 {
1777 Lisp_Object keymap, local_map;
1778 EMACS_INT pt;
1779
1780 pt = INTEGERP (position) ? XINT (position)
1781 : MARKERP (position) ? marker_position (position)
1782 : PT;
1783
1784 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1785 keymap = get_local_map (pt, current_buffer, Qkeymap);
1786
1787 if (CONSP (position))
1788 {
1789 Lisp_Object string;
1790
1791 /* For a mouse click, get the local text-property keymap
1792 of the place clicked on, rather than point. */
1793
1794 if (POSN_INBUFFER_P (position))
1795 {
1796 Lisp_Object pos;
1797
1798 pos = POSN_BUFFER_POSN (position);
1799 if (INTEGERP (pos)
1800 && XINT (pos) >= BEG && XINT (pos) <= Z)
1801 {
1802 local_map = get_local_map (XINT (pos),
1803 current_buffer, Qlocal_map);
1804
1805 keymap = get_local_map (XINT (pos),
1806 current_buffer, Qkeymap);
1807 }
1808 }
1809
1810 /* If on a mode line string with a local keymap,
1811 or for a click on a string, i.e. overlay string or a
1812 string displayed via the `display' property,
1813 consider `local-map' and `keymap' properties of
1814 that string. */
1815
1816 if (string = POSN_STRING (position),
1817 (CONSP (string) && STRINGP (XCAR (string))))
1818 {
1819 Lisp_Object pos, map;
1820
1821 pos = XCDR (string);
1822 string = XCAR (string);
1823 if (INTEGERP (pos)
1824 && XINT (pos) >= 0
1825 && XINT (pos) < SCHARS (string))
1826 {
1827 map = Fget_text_property (pos, Qlocal_map, string);
1828 if (!NILP (map))
1829 local_map = map;
1830
1831 map = Fget_text_property (pos, Qkeymap, string);
1832 if (!NILP (map))
1833 keymap = map;
1834 }
1835 }
1836
1837 }
1838
1839 if (! NILP (keymap))
1840 {
1841 value = Flookup_key (keymap, key, accept_default);
1842 if (! NILP (value) && !INTEGERP (value))
1843 goto done;
1844 }
1845
1846 nmaps = current_minor_maps (0, &maps);
1847 /* Note that all these maps are GCPRO'd
1848 in the places where we found them. */
1849
1850 for (i = 0; i < nmaps; i++)
1851 if (! NILP (maps[i]))
1852 {
1853 value = Flookup_key (maps[i], key, accept_default);
1854 if (! NILP (value) && !INTEGERP (value))
1855 goto done;
1856 }
1857
1858 if (! NILP (local_map))
1859 {
1860 value = Flookup_key (local_map, key, accept_default);
1861 if (! NILP (value) && !INTEGERP (value))
1862 goto done;
1863 }
1864 }
1865
1866 value = Flookup_key (current_global_map, key, accept_default);
1867
1868 done:
1869 unbind_to (count, Qnil);
1870
1871 UNGCPRO;
1872 if (NILP (value) || INTEGERP (value))
1873 return Qnil;
1874
1875 /* If the result of the ordinary keymap lookup is an interactive
1876 command, look for a key binding (ie. remapping) for that command. */
1877
1878 if (NILP (no_remap) && SYMBOLP (value))
1879 {
1880 Lisp_Object value1;
1881 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1882 value = value1;
1883 }
1884
1885 return value;
1886 }
1887
1888 /* GC is possible in this function if it autoloads a keymap. */
1889
1890 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1891 doc: /* Return the binding for command KEYS in current local keymap only.
1892 KEYS is a string or vector, a sequence of keystrokes.
1893 The binding is probably a symbol with a function definition.
1894
1895 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1896 bindings; see the description of `lookup-key' for more details about this. */)
1897 (keys, accept_default)
1898 Lisp_Object keys, accept_default;
1899 {
1900 register Lisp_Object map;
1901 map = current_buffer->keymap;
1902 if (NILP (map))
1903 return Qnil;
1904 return Flookup_key (map, keys, accept_default);
1905 }
1906
1907 /* GC is possible in this function if it autoloads a keymap. */
1908
1909 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1910 doc: /* Return the binding for command KEYS in current global keymap only.
1911 KEYS is a string or vector, a sequence of keystrokes.
1912 The binding is probably a symbol with a function definition.
1913 This function's return values are the same as those of `lookup-key'
1914 \(which see).
1915
1916 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1917 bindings; see the description of `lookup-key' for more details about this. */)
1918 (keys, accept_default)
1919 Lisp_Object keys, accept_default;
1920 {
1921 return Flookup_key (current_global_map, keys, accept_default);
1922 }
1923
1924 /* GC is possible in this function if it autoloads a keymap. */
1925
1926 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1927 doc: /* Find the visible minor mode bindings of KEY.
1928 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1929 the symbol which names the minor mode binding KEY, and BINDING is
1930 KEY's definition in that mode. In particular, if KEY has no
1931 minor-mode bindings, return nil. If the first binding is a
1932 non-prefix, all subsequent bindings will be omitted, since they would
1933 be ignored. Similarly, the list doesn't include non-prefix bindings
1934 that come after prefix bindings.
1935
1936 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1937 bindings; see the description of `lookup-key' for more details about this. */)
1938 (key, accept_default)
1939 Lisp_Object key, accept_default;
1940 {
1941 Lisp_Object *modes, *maps;
1942 int nmaps;
1943 Lisp_Object binding;
1944 int i, j;
1945 struct gcpro gcpro1, gcpro2;
1946
1947 nmaps = current_minor_maps (&modes, &maps);
1948 /* Note that all these maps are GCPRO'd
1949 in the places where we found them. */
1950
1951 binding = Qnil;
1952 GCPRO2 (key, binding);
1953
1954 for (i = j = 0; i < nmaps; i++)
1955 if (!NILP (maps[i])
1956 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1957 && !INTEGERP (binding))
1958 {
1959 if (KEYMAPP (binding))
1960 maps[j++] = Fcons (modes[i], binding);
1961 else if (j == 0)
1962 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1963 }
1964
1965 UNGCPRO;
1966 return Flist (j, maps);
1967 }
1968
1969 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1970 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1971 A new sparse keymap is stored as COMMAND's function definition and its value.
1972 If a second optional argument MAPVAR is given, the map is stored as
1973 its value instead of as COMMAND's value; but COMMAND is still defined
1974 as a function.
1975 The third optional argument NAME, if given, supplies a menu name
1976 string for the map. This is required to use the keymap as a menu.
1977 This function returns COMMAND. */)
1978 (command, mapvar, name)
1979 Lisp_Object command, mapvar, name;
1980 {
1981 Lisp_Object map;
1982 map = Fmake_sparse_keymap (name);
1983 Ffset (command, map);
1984 if (!NILP (mapvar))
1985 Fset (mapvar, map);
1986 else
1987 Fset (command, map);
1988 return command;
1989 }
1990
1991 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1992 doc: /* Select KEYMAP as the global keymap. */)
1993 (keymap)
1994 Lisp_Object keymap;
1995 {
1996 keymap = get_keymap (keymap, 1, 1);
1997 current_global_map = keymap;
1998
1999 return Qnil;
2000 }
2001
2002 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
2003 doc: /* Select KEYMAP as the local keymap.
2004 If KEYMAP is nil, that means no local keymap. */)
2005 (keymap)
2006 Lisp_Object keymap;
2007 {
2008 if (!NILP (keymap))
2009 keymap = get_keymap (keymap, 1, 1);
2010
2011 current_buffer->keymap = keymap;
2012
2013 return Qnil;
2014 }
2015
2016 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
2017 doc: /* Return current buffer's local keymap, or nil if it has none. */)
2018 ()
2019 {
2020 return current_buffer->keymap;
2021 }
2022
2023 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2024 doc: /* Return the current global keymap. */)
2025 ()
2026 {
2027 return current_global_map;
2028 }
2029
2030 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2031 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2032 ()
2033 {
2034 Lisp_Object *maps;
2035 int nmaps = current_minor_maps (0, &maps);
2036
2037 return Flist (nmaps, maps);
2038 }
2039 \f
2040 /* Help functions for describing and documenting keymaps. */
2041
2042 struct accessible_keymaps_data {
2043 Lisp_Object maps, tail, thisseq;
2044 /* Does the current sequence end in the meta-prefix-char? */
2045 int is_metized;
2046 };
2047
2048 static void
2049 accessible_keymaps_1 (key, cmd, args, data)
2050 Lisp_Object key, cmd, args;
2051 /* Use void* to be compatible with map_keymap_function_t. */
2052 void *data;
2053 {
2054 struct accessible_keymaps_data *d = data; /* Cast! */
2055 Lisp_Object maps = d->maps;
2056 Lisp_Object tail = d->tail;
2057 Lisp_Object thisseq = d->thisseq;
2058 int is_metized = d->is_metized && INTEGERP (key);
2059 Lisp_Object tem;
2060
2061 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2062 if (NILP (cmd))
2063 return;
2064
2065 /* Look for and break cycles. */
2066 while (!NILP (tem = Frassq (cmd, maps)))
2067 {
2068 Lisp_Object prefix = XCAR (tem);
2069 int lim = XINT (Flength (XCAR (tem)));
2070 if (lim <= XINT (Flength (thisseq)))
2071 { /* This keymap was already seen with a smaller prefix. */
2072 int i = 0;
2073 while (i < lim && EQ (Faref (prefix, make_number (i)),
2074 Faref (thisseq, make_number (i))))
2075 i++;
2076 if (i >= lim)
2077 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2078 return;
2079 }
2080 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2081 but maybe `cmd' occurs again further down in `maps', so keep
2082 looking. */
2083 maps = XCDR (Fmemq (tem, maps));
2084 }
2085
2086 /* If the last key in thisseq is meta-prefix-char,
2087 turn it into a meta-ized keystroke. We know
2088 that the event we're about to append is an
2089 ascii keystroke since we're processing a
2090 keymap table. */
2091 if (is_metized)
2092 {
2093 int meta_bit = meta_modifier;
2094 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2095 tem = Fcopy_sequence (thisseq);
2096
2097 Faset (tem, last, make_number (XINT (key) | meta_bit));
2098
2099 /* This new sequence is the same length as
2100 thisseq, so stick it in the list right
2101 after this one. */
2102 XSETCDR (tail,
2103 Fcons (Fcons (tem, cmd), XCDR (tail)));
2104 }
2105 else
2106 {
2107 tem = append_key (thisseq, key);
2108 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2109 }
2110 }
2111
2112 /* This function cannot GC. */
2113
2114 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2115 1, 2, 0,
2116 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2117 Returns a list of elements of the form (KEYS . MAP), where the sequence
2118 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2119 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2120 An optional argument PREFIX, if non-nil, should be a key sequence;
2121 then the value includes only maps for prefixes that start with PREFIX. */)
2122 (keymap, prefix)
2123 Lisp_Object keymap, prefix;
2124 {
2125 Lisp_Object maps, tail;
2126 int prefixlen = XINT (Flength (prefix));
2127
2128 /* no need for gcpro because we don't autoload any keymaps. */
2129
2130 if (!NILP (prefix))
2131 {
2132 /* If a prefix was specified, start with the keymap (if any) for
2133 that prefix, so we don't waste time considering other prefixes. */
2134 Lisp_Object tem;
2135 tem = Flookup_key (keymap, prefix, Qt);
2136 /* Flookup_key may give us nil, or a number,
2137 if the prefix is not defined in this particular map.
2138 It might even give us a list that isn't a keymap. */
2139 tem = get_keymap (tem, 0, 0);
2140 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2141 want to return it. */
2142 if (!NILP (tem))
2143 {
2144 /* Convert PREFIX to a vector now, so that later on
2145 we don't have to deal with the possibility of a string. */
2146 if (STRINGP (prefix))
2147 {
2148 int i, i_byte, c;
2149 Lisp_Object copy;
2150
2151 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2152 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2153 {
2154 int i_before = i;
2155
2156 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2157 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2158 c ^= 0200 | meta_modifier;
2159 ASET (copy, i_before, make_number (c));
2160 }
2161 prefix = copy;
2162 }
2163 maps = Fcons (Fcons (prefix, tem), Qnil);
2164 }
2165 else
2166 return Qnil;
2167 }
2168 else
2169 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2170 get_keymap (keymap, 1, 0)),
2171 Qnil);
2172
2173 /* For each map in the list maps,
2174 look at any other maps it points to,
2175 and stick them at the end if they are not already in the list.
2176
2177 This is a breadth-first traversal, where tail is the queue of
2178 nodes, and maps accumulates a list of all nodes visited. */
2179
2180 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2181 {
2182 struct accessible_keymaps_data data;
2183 register Lisp_Object thismap = Fcdr (XCAR (tail));
2184 Lisp_Object last;
2185
2186 data.thisseq = Fcar (XCAR (tail));
2187 data.maps = maps;
2188 data.tail = tail;
2189 last = make_number (XINT (Flength (data.thisseq)) - 1);
2190 /* Does the current sequence end in the meta-prefix-char? */
2191 data.is_metized = (XINT (last) >= 0
2192 /* Don't metize the last char of PREFIX. */
2193 && XINT (last) >= prefixlen
2194 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2195
2196 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2197 if (CONSP (thismap))
2198 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2199 }
2200 return maps;
2201 }
2202 Lisp_Object Qsingle_key_description, Qkey_description;
2203
2204 /* This function cannot GC. */
2205
2206 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2207 doc: /* Return a pretty description of key-sequence KEYS.
2208 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2209 Control characters turn into "C-foo" sequences, meta into "M-foo",
2210 spaces are put between sequence elements, etc. */)
2211 (keys, prefix)
2212 Lisp_Object keys, prefix;
2213 {
2214 int len = 0;
2215 int i, i_byte;
2216 Lisp_Object *args;
2217 int size = XINT (Flength (keys));
2218 Lisp_Object list;
2219 Lisp_Object sep = build_string (" ");
2220 Lisp_Object key;
2221 int add_meta = 0;
2222
2223 if (!NILP (prefix))
2224 size += XINT (Flength (prefix));
2225
2226 /* This has one extra element at the end that we don't pass to Fconcat. */
2227 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2228
2229 /* In effect, this computes
2230 (mapconcat 'single-key-description keys " ")
2231 but we shouldn't use mapconcat because it can do GC. */
2232
2233 next_list:
2234 if (!NILP (prefix))
2235 list = prefix, prefix = Qnil;
2236 else if (!NILP (keys))
2237 list = keys, keys = Qnil;
2238 else
2239 {
2240 if (add_meta)
2241 {
2242 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2243 len += 2;
2244 }
2245 else if (len == 0)
2246 return empty_unibyte_string;
2247 return Fconcat (len - 1, args);
2248 }
2249
2250 if (STRINGP (list))
2251 size = SCHARS (list);
2252 else if (VECTORP (list))
2253 size = XVECTOR (list)->size;
2254 else if (CONSP (list))
2255 size = XINT (Flength (list));
2256 else
2257 wrong_type_argument (Qarrayp, list);
2258
2259 i = i_byte = 0;
2260
2261 while (i < size)
2262 {
2263 if (STRINGP (list))
2264 {
2265 int c;
2266 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2267 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2268 c ^= 0200 | meta_modifier;
2269 XSETFASTINT (key, c);
2270 }
2271 else if (VECTORP (list))
2272 {
2273 key = AREF (list, i++);
2274 }
2275 else
2276 {
2277 key = XCAR (list);
2278 list = XCDR (list);
2279 i++;
2280 }
2281
2282 if (add_meta)
2283 {
2284 if (!INTEGERP (key)
2285 || EQ (key, meta_prefix_char)
2286 || (XINT (key) & meta_modifier))
2287 {
2288 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2289 args[len++] = sep;
2290 if (EQ (key, meta_prefix_char))
2291 continue;
2292 }
2293 else
2294 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2295 add_meta = 0;
2296 }
2297 else if (EQ (key, meta_prefix_char))
2298 {
2299 add_meta = 1;
2300 continue;
2301 }
2302 args[len++] = Fsingle_key_description (key, Qnil);
2303 args[len++] = sep;
2304 }
2305 goto next_list;
2306 }
2307
2308
2309 char *
2310 push_key_description (c, p, force_multibyte)
2311 register unsigned int c;
2312 register char *p;
2313 int force_multibyte;
2314 {
2315 unsigned c2;
2316 int valid_p;
2317
2318 /* Clear all the meaningless bits above the meta bit. */
2319 c &= meta_modifier | ~ - meta_modifier;
2320 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2321 | meta_modifier | shift_modifier | super_modifier);
2322
2323 valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0);
2324 if (! valid_p)
2325 {
2326 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2327 p += sprintf (p, "[%d]", c);
2328 return p;
2329 }
2330
2331 if (c & alt_modifier)
2332 {
2333 *p++ = 'A';
2334 *p++ = '-';
2335 c -= alt_modifier;
2336 }
2337 if ((c & ctrl_modifier) != 0
2338 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2339 {
2340 *p++ = 'C';
2341 *p++ = '-';
2342 c &= ~ctrl_modifier;
2343 }
2344 if (c & hyper_modifier)
2345 {
2346 *p++ = 'H';
2347 *p++ = '-';
2348 c -= hyper_modifier;
2349 }
2350 if (c & meta_modifier)
2351 {
2352 *p++ = 'M';
2353 *p++ = '-';
2354 c -= meta_modifier;
2355 }
2356 if (c & shift_modifier)
2357 {
2358 *p++ = 'S';
2359 *p++ = '-';
2360 c -= shift_modifier;
2361 }
2362 if (c & super_modifier)
2363 {
2364 *p++ = 's';
2365 *p++ = '-';
2366 c -= super_modifier;
2367 }
2368 if (c < 040)
2369 {
2370 if (c == 033)
2371 {
2372 *p++ = 'E';
2373 *p++ = 'S';
2374 *p++ = 'C';
2375 }
2376 else if (c == '\t')
2377 {
2378 *p++ = 'T';
2379 *p++ = 'A';
2380 *p++ = 'B';
2381 }
2382 else if (c == Ctl ('M'))
2383 {
2384 *p++ = 'R';
2385 *p++ = 'E';
2386 *p++ = 'T';
2387 }
2388 else
2389 {
2390 /* `C-' already added above. */
2391 if (c > 0 && c <= Ctl ('Z'))
2392 *p++ = c + 0140;
2393 else
2394 *p++ = c + 0100;
2395 }
2396 }
2397 else if (c == 0177)
2398 {
2399 *p++ = 'D';
2400 *p++ = 'E';
2401 *p++ = 'L';
2402 }
2403 else if (c == ' ')
2404 {
2405 *p++ = 'S';
2406 *p++ = 'P';
2407 *p++ = 'C';
2408 }
2409 else if (c < 128
2410 || (NILP (current_buffer->enable_multibyte_characters)
2411 && SINGLE_BYTE_CHAR_P (c)
2412 && !force_multibyte))
2413 {
2414 *p++ = c;
2415 }
2416 else
2417 {
2418 if (force_multibyte)
2419 {
2420 if (SINGLE_BYTE_CHAR_P (c))
2421 c = unibyte_char_to_multibyte (c);
2422 p += CHAR_STRING (c, p);
2423 }
2424 else if (NILP (current_buffer->enable_multibyte_characters))
2425 {
2426 int bit_offset;
2427 *p++ = '\\';
2428 /* The biggest character code uses 19 bits. */
2429 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
2430 {
2431 if (c >= (1 << bit_offset))
2432 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
2433 }
2434 }
2435 else
2436 p += CHAR_STRING (c, p);
2437 }
2438
2439 return p;
2440 }
2441
2442 /* This function cannot GC. */
2443
2444 DEFUN ("single-key-description", Fsingle_key_description,
2445 Ssingle_key_description, 1, 2, 0,
2446 doc: /* Return a pretty description of command character KEY.
2447 Control characters turn into C-whatever, etc.
2448 Optional argument NO-ANGLES non-nil means don't put angle brackets
2449 around function keys and event symbols. */)
2450 (key, no_angles)
2451 Lisp_Object key, no_angles;
2452 {
2453 if (CONSP (key) && lucid_event_type_list_p (key))
2454 key = Fevent_convert_list (key);
2455
2456 key = EVENT_HEAD (key);
2457
2458 if (INTEGERP (key)) /* Normal character */
2459 {
2460 unsigned int charset, c1, c2;
2461 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
2462
2463 if (SINGLE_BYTE_CHAR_P (without_bits))
2464 charset = 0;
2465 else
2466 SPLIT_CHAR (without_bits, charset, c1, c2);
2467
2468 if (! CHAR_VALID_P (without_bits, 1))
2469 {
2470 char buf[256];
2471
2472 sprintf (buf, "Invalid char code %ld", XINT (key));
2473 return build_string (buf);
2474 }
2475 else if (charset
2476 && ((c1 == 0 && c2 == -1) || c2 == 0))
2477 {
2478 /* Handle a generic character. */
2479 Lisp_Object name;
2480 char buf[256];
2481
2482 name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
2483 CHECK_STRING (name);
2484 if (c1 == 0)
2485 /* Only a charset is specified. */
2486 sprintf (buf, "Generic char %d: all of ", without_bits);
2487 else
2488 /* 1st code-point of 2-dimensional charset is specified. */
2489 sprintf (buf, "Generic char %d: row %d of ", without_bits, c1);
2490 return concat2 (build_string (buf), name);
2491 }
2492 else
2493 {
2494 char tem[KEY_DESCRIPTION_SIZE], *end;
2495 int nbytes, nchars;
2496 Lisp_Object string;
2497
2498 end = push_key_description (XUINT (key), tem, 1);
2499 nbytes = end - tem;
2500 nchars = multibyte_chars_in_text (tem, nbytes);
2501 if (nchars == nbytes)
2502 {
2503 *end = '\0';
2504 string = build_string (tem);
2505 }
2506 else
2507 string = make_multibyte_string (tem, nchars, nbytes);
2508 return string;
2509 }
2510 }
2511 else if (SYMBOLP (key)) /* Function key or event-symbol */
2512 {
2513 if (NILP (no_angles))
2514 {
2515 char *buffer
2516 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2517 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2518 return build_string (buffer);
2519 }
2520 else
2521 return Fsymbol_name (key);
2522 }
2523 else if (STRINGP (key)) /* Buffer names in the menubar. */
2524 return Fcopy_sequence (key);
2525 else
2526 error ("KEY must be an integer, cons, symbol, or string");
2527 return Qnil;
2528 }
2529
2530 char *
2531 push_text_char_description (c, p)
2532 register unsigned int c;
2533 register char *p;
2534 {
2535 if (c >= 0200)
2536 {
2537 *p++ = 'M';
2538 *p++ = '-';
2539 c -= 0200;
2540 }
2541 if (c < 040)
2542 {
2543 *p++ = '^';
2544 *p++ = c + 64; /* 'A' - 1 */
2545 }
2546 else if (c == 0177)
2547 {
2548 *p++ = '^';
2549 *p++ = '?';
2550 }
2551 else
2552 *p++ = c;
2553 return p;
2554 }
2555
2556 /* This function cannot GC. */
2557
2558 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2559 doc: /* Return a pretty description of file-character CHARACTER.
2560 Control characters turn into "^char", etc. This differs from
2561 `single-key-description' which turns them into "C-char".
2562 Also, this function recognizes the 2**7 bit as the Meta character,
2563 whereas `single-key-description' uses the 2**27 bit for Meta.
2564 See Info node `(elisp)Describing Characters' for examples. */)
2565 (character)
2566 Lisp_Object character;
2567 {
2568 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2569 unsigned char str[6];
2570 int c;
2571
2572 CHECK_NUMBER (character);
2573
2574 c = XINT (character);
2575 if (!SINGLE_BYTE_CHAR_P (c))
2576 {
2577 int len = CHAR_STRING (c, str);
2578
2579 return make_multibyte_string (str, 1, len);
2580 }
2581
2582 *push_text_char_description (c & 0377, str) = 0;
2583
2584 return build_string (str);
2585 }
2586
2587 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2588 a meta bit. */
2589 static int
2590 ascii_sequence_p (seq)
2591 Lisp_Object seq;
2592 {
2593 int i;
2594 int len = XINT (Flength (seq));
2595
2596 for (i = 0; i < len; i++)
2597 {
2598 Lisp_Object ii, elt;
2599
2600 XSETFASTINT (ii, i);
2601 elt = Faref (seq, ii);
2602
2603 if (!INTEGERP (elt)
2604 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2605 return 0;
2606 }
2607
2608 return 1;
2609 }
2610
2611 \f
2612 /* where-is - finding a command in a set of keymaps. */
2613
2614 static Lisp_Object where_is_internal ();
2615 static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
2616 Lisp_Object args, void *data));
2617
2618 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2619 Returns the first non-nil binding found in any of those maps. */
2620
2621 static Lisp_Object
2622 shadow_lookup (shadow, key, flag)
2623 Lisp_Object shadow, key, flag;
2624 {
2625 Lisp_Object tail, value;
2626
2627 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2628 {
2629 value = Flookup_key (XCAR (tail), key, flag);
2630 if (NATNUMP (value))
2631 {
2632 value = Flookup_key (XCAR (tail),
2633 Fsubstring (key, make_number (0), value), flag);
2634 if (!NILP (value))
2635 return Qnil;
2636 }
2637 else if (!NILP (value))
2638 return value;
2639 }
2640 return Qnil;
2641 }
2642
2643 static Lisp_Object Vmouse_events;
2644
2645 struct where_is_internal_data {
2646 Lisp_Object definition, noindirect, this, last;
2647 int last_is_meta;
2648 Lisp_Object sequences;
2649 };
2650
2651 /* This function can GC if Flookup_key autoloads any keymaps. */
2652
2653 static Lisp_Object
2654 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2655 Lisp_Object definition, keymaps;
2656 Lisp_Object firstonly, noindirect, no_remap;
2657 {
2658 Lisp_Object maps = Qnil;
2659 Lisp_Object found, sequences;
2660 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2661 /* 1 means ignore all menu bindings entirely. */
2662 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2663
2664 found = keymaps;
2665 while (CONSP (found))
2666 {
2667 maps =
2668 nconc2 (maps,
2669 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2670 found = XCDR (found);
2671 }
2672
2673 GCPRO5 (definition, keymaps, maps, found, sequences);
2674 found = Qnil;
2675 sequences = Qnil;
2676
2677 /* If this command is remapped, then it has no key bindings
2678 of its own. */
2679 if (NILP (no_remap)
2680 && SYMBOLP (definition)
2681 && !NILP (Fcommand_remapping (definition, Qnil, keymaps)))
2682 RETURN_UNGCPRO (Qnil);
2683
2684 for (; !NILP (maps); maps = Fcdr (maps))
2685 {
2686 /* Key sequence to reach map, and the map that it reaches */
2687 register Lisp_Object this, map, tem;
2688 struct where_is_internal_data data;
2689
2690 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2691 [M-CHAR] sequences, check if last character of the sequence
2692 is the meta-prefix char. */
2693 Lisp_Object last;
2694 int last_is_meta;
2695
2696 this = Fcar (Fcar (maps));
2697 map = Fcdr (Fcar (maps));
2698 last = make_number (XINT (Flength (this)) - 1);
2699 last_is_meta = (XINT (last) >= 0
2700 && EQ (Faref (this, last), meta_prefix_char));
2701
2702 /* if (nomenus && !ascii_sequence_p (this)) */
2703 if (nomenus && XINT (last) >= 0
2704 && SYMBOLP (tem = Faref (this, make_number (0)))
2705 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2706 /* If no menu entries should be returned, skip over the
2707 keymaps bound to `menu-bar' and `tool-bar' and other
2708 non-ascii prefixes like `C-down-mouse-2'. */
2709 continue;
2710
2711 QUIT;
2712
2713 data.definition = definition;
2714 data.noindirect = noindirect;
2715 data.this = this;
2716 data.last = last;
2717 data.last_is_meta = last_is_meta;
2718 data.sequences = Qnil;
2719
2720 if (CONSP (map))
2721 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2722
2723 sequences = data.sequences;
2724
2725 while (CONSP (sequences))
2726 {
2727 Lisp_Object sequence, remapped, function;
2728
2729 sequence = XCAR (sequences);
2730 sequences = XCDR (sequences);
2731
2732 /* If the current sequence is a command remapping with
2733 format [remap COMMAND], find the key sequences
2734 which run COMMAND, and use those sequences instead. */
2735 remapped = Qnil;
2736 if (NILP (no_remap)
2737 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2738 && EQ (AREF (sequence, 0), Qremap)
2739 && (function = AREF (sequence, 1), SYMBOLP (function)))
2740 {
2741 Lisp_Object remapped1;
2742
2743 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2744 if (CONSP (remapped1))
2745 {
2746 /* Verify that this key binding actually maps to the
2747 remapped command (see below). */
2748 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2749 continue;
2750 sequence = XCAR (remapped1);
2751 remapped = XCDR (remapped1);
2752 goto record_sequence;
2753 }
2754 }
2755
2756 /* Verify that this key binding is not shadowed by another
2757 binding for the same key, before we say it exists.
2758
2759 Mechanism: look for local definition of this key and if
2760 it is defined and does not match what we found then
2761 ignore this key.
2762
2763 Either nil or number as value from Flookup_key
2764 means undefined. */
2765 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2766 continue;
2767
2768 record_sequence:
2769 /* Don't annoy user with strings from a menu such as
2770 Select Paste. Change them all to "(any string)",
2771 so that there seems to be only one menu item
2772 to report. */
2773 if (! NILP (sequence))
2774 {
2775 Lisp_Object tem;
2776 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2777 if (STRINGP (tem))
2778 Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2779 build_string ("(any string)"));
2780 }
2781
2782 /* It is a true unshadowed match. Record it, unless it's already
2783 been seen (as could happen when inheriting keymaps). */
2784 if (NILP (Fmember (sequence, found)))
2785 found = Fcons (sequence, found);
2786
2787 /* If firstonly is Qnon_ascii, then we can return the first
2788 binding we find. If firstonly is not Qnon_ascii but not
2789 nil, then we should return the first ascii-only binding
2790 we find. */
2791 if (EQ (firstonly, Qnon_ascii))
2792 RETURN_UNGCPRO (sequence);
2793 else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2794 RETURN_UNGCPRO (sequence);
2795
2796 if (CONSP (remapped))
2797 {
2798 sequence = XCAR (remapped);
2799 remapped = XCDR (remapped);
2800 goto record_sequence;
2801 }
2802 }
2803 }
2804
2805 UNGCPRO;
2806
2807 found = Fnreverse (found);
2808
2809 /* firstonly may have been t, but we may have gone all the way through
2810 the keymaps without finding an all-ASCII key sequence. So just
2811 return the best we could find. */
2812 if (!NILP (firstonly))
2813 return Fcar (found);
2814
2815 return found;
2816 }
2817
2818 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2819 doc: /* Return list of keys that invoke DEFINITION.
2820 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2821 If KEYMAP is nil, search all the currently active keymaps.
2822 If KEYMAP is a list of keymaps, search only those keymaps.
2823
2824 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2825 rather than a list of all possible key sequences.
2826 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2827 no matter what it is.
2828 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2829 \(or their meta variants) and entirely reject menu bindings.
2830
2831 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2832 to other keymaps or slots. This makes it possible to search for an
2833 indirect definition itself.
2834
2835 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2836 that invoke a command which is remapped to DEFINITION, but include the
2837 remapped command in the returned list. */)
2838 (definition, keymap, firstonly, noindirect, no_remap)
2839 Lisp_Object definition, keymap;
2840 Lisp_Object firstonly, noindirect, no_remap;
2841 {
2842 Lisp_Object sequences, keymaps;
2843 /* 1 means ignore all menu bindings entirely. */
2844 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2845 Lisp_Object result;
2846
2847 /* Find the relevant keymaps. */
2848 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2849 keymaps = keymap;
2850 else if (!NILP (keymap))
2851 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2852 else
2853 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2854
2855 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2856 We don't really need to check `keymap'. */
2857 if (nomenus && NILP (noindirect) && NILP (keymap))
2858 {
2859 Lisp_Object *defns;
2860 int i, j, n;
2861 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2862
2863 /* Check heuristic-consistency of the cache. */
2864 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2865 where_is_cache = Qnil;
2866
2867 if (NILP (where_is_cache))
2868 {
2869 /* We need to create the cache. */
2870 Lisp_Object args[2];
2871 where_is_cache = Fmake_hash_table (0, args);
2872 where_is_cache_keymaps = Qt;
2873
2874 /* Fill in the cache. */
2875 GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2876 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2877 UNGCPRO;
2878
2879 where_is_cache_keymaps = keymaps;
2880 }
2881
2882 /* We want to process definitions from the last to the first.
2883 Instead of consing, copy definitions to a vector and step
2884 over that vector. */
2885 sequences = Fgethash (definition, where_is_cache, Qnil);
2886 n = XINT (Flength (sequences));
2887 defns = (Lisp_Object *) alloca (n * sizeof *defns);
2888 for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2889 defns[i++] = XCAR (sequences);
2890
2891 /* Verify that the key bindings are not shadowed. Note that
2892 the following can GC. */
2893 GCPRO2 (definition, keymaps);
2894 result = Qnil;
2895 j = -1;
2896 for (i = n - 1; i >= 0; --i)
2897 if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2898 {
2899 if (ascii_sequence_p (defns[i]))
2900 break;
2901 else if (j < 0)
2902 j = i;
2903 }
2904
2905 result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
2906 UNGCPRO;
2907 }
2908 else
2909 {
2910 /* Kill the cache so that where_is_internal_1 doesn't think
2911 we're filling it up. */
2912 where_is_cache = Qnil;
2913 result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2914 }
2915
2916 return result;
2917 }
2918
2919 /* This function can GC because get_keyelt can. */
2920
2921 static void
2922 where_is_internal_1 (key, binding, args, data)
2923 Lisp_Object key, binding, args;
2924 void *data;
2925 {
2926 struct where_is_internal_data *d = data; /* Cast! */
2927 Lisp_Object definition = d->definition;
2928 Lisp_Object noindirect = d->noindirect;
2929 Lisp_Object this = d->this;
2930 Lisp_Object last = d->last;
2931 int last_is_meta = d->last_is_meta;
2932 Lisp_Object sequence;
2933
2934 /* Search through indirections unless that's not wanted. */
2935 if (NILP (noindirect))
2936 binding = get_keyelt (binding, 0);
2937
2938 /* End this iteration if this element does not match
2939 the target. */
2940
2941 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2942 || EQ (binding, definition)
2943 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2944 /* Doesn't match. */
2945 return;
2946
2947 /* We have found a match. Construct the key sequence where we found it. */
2948 if (INTEGERP (key) && last_is_meta)
2949 {
2950 sequence = Fcopy_sequence (this);
2951 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2952 }
2953 else
2954 sequence = append_key (this, key);
2955
2956 if (!NILP (where_is_cache))
2957 {
2958 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2959 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2960 }
2961 else
2962 d->sequences = Fcons (sequence, d->sequences);
2963 }
2964 \f
2965 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2966
2967 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2968 doc: /* Insert the list of all defined keys and their definitions.
2969 The list is inserted in the current buffer, while the bindings are
2970 looked up in BUFFER.
2971 The optional argument PREFIX, if non-nil, should be a key sequence;
2972 then we display only bindings that start with that prefix.
2973 The optional argument MENUS, if non-nil, says to mention menu bindings.
2974 \(Ordinarily these are omitted from the output.) */)
2975 (buffer, prefix, menus)
2976 Lisp_Object buffer, prefix, menus;
2977 {
2978 Lisp_Object outbuf, shadow;
2979 int nomenu = NILP (menus);
2980 register Lisp_Object start1;
2981 struct gcpro gcpro1;
2982
2983 char *alternate_heading
2984 = "\
2985 Keyboard translations:\n\n\
2986 You type Translation\n\
2987 -------- -----------\n";
2988
2989 CHECK_BUFFER (buffer);
2990
2991 shadow = Qnil;
2992 GCPRO1 (shadow);
2993
2994 outbuf = Fcurrent_buffer ();
2995
2996 /* Report on alternates for keys. */
2997 if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix))
2998 {
2999 int c;
3000 const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table);
3001 int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table);
3002
3003 for (c = 0; c < translate_len; c++)
3004 if (translate[c] != c)
3005 {
3006 char buf[KEY_DESCRIPTION_SIZE];
3007 char *bufend;
3008
3009 if (alternate_heading)
3010 {
3011 insert_string (alternate_heading);
3012 alternate_heading = 0;
3013 }
3014
3015 bufend = push_key_description (translate[c], buf, 1);
3016 insert (buf, bufend - buf);
3017 Findent_to (make_number (16), make_number (1));
3018 bufend = push_key_description (c, buf, 1);
3019 insert (buf, bufend - buf);
3020
3021 insert ("\n", 1);
3022
3023 /* Insert calls signal_after_change which may GC. */
3024 translate = SDATA (current_kboard->Vkeyboard_translate_table);
3025 }
3026
3027 insert ("\n", 1);
3028 }
3029
3030 if (!NILP (current_kboard->Vlocal_key_translation_map))
3031 describe_map_tree (current_kboard->Vlocal_key_translation_map, 0, Qnil, prefix,
3032 "Key translations", nomenu, 1, 0, 0);
3033
3034
3035 /* Print the (major mode) local map. */
3036 start1 = Qnil;
3037 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3038 start1 = current_kboard->Voverriding_terminal_local_map;
3039 else if (!NILP (Voverriding_local_map))
3040 start1 = Voverriding_local_map;
3041
3042 if (!NILP (start1))
3043 {
3044 describe_map_tree (start1, 1, shadow, prefix,
3045 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3046 shadow = Fcons (start1, shadow);
3047 }
3048 else
3049 {
3050 /* Print the minor mode and major mode keymaps. */
3051 int i, nmaps;
3052 Lisp_Object *modes, *maps;
3053
3054 /* Temporarily switch to `buffer', so that we can get that buffer's
3055 minor modes correctly. */
3056 Fset_buffer (buffer);
3057
3058 nmaps = current_minor_maps (&modes, &maps);
3059 Fset_buffer (outbuf);
3060
3061 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3062 XBUFFER (buffer), Qkeymap);
3063 if (!NILP (start1))
3064 {
3065 describe_map_tree (start1, 1, shadow, prefix,
3066 "\f\n`keymap' Property Bindings", nomenu,
3067 0, 0, 0);
3068 shadow = Fcons (start1, shadow);
3069 }
3070
3071 /* Print the minor mode maps. */
3072 for (i = 0; i < nmaps; i++)
3073 {
3074 /* The title for a minor mode keymap
3075 is constructed at run time.
3076 We let describe_map_tree do the actual insertion
3077 because it takes care of other features when doing so. */
3078 char *title, *p;
3079
3080 if (!SYMBOLP (modes[i]))
3081 abort();
3082
3083 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3084 *p++ = '\f';
3085 *p++ = '\n';
3086 *p++ = '`';
3087 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3088 SCHARS (SYMBOL_NAME (modes[i])));
3089 p += SCHARS (SYMBOL_NAME (modes[i]));
3090 *p++ = '\'';
3091 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3092 p += sizeof (" Minor Mode Bindings") - 1;
3093 *p = 0;
3094
3095 describe_map_tree (maps[i], 1, shadow, prefix,
3096 title, nomenu, 0, 0, 0);
3097 shadow = Fcons (maps[i], shadow);
3098 }
3099
3100 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3101 XBUFFER (buffer), Qlocal_map);
3102 if (!NILP (start1))
3103 {
3104 if (EQ (start1, XBUFFER (buffer)->keymap))
3105 describe_map_tree (start1, 1, shadow, prefix,
3106 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3107 else
3108 describe_map_tree (start1, 1, shadow, prefix,
3109 "\f\n`local-map' Property Bindings",
3110 nomenu, 0, 0, 0);
3111
3112 shadow = Fcons (start1, shadow);
3113 }
3114 }
3115
3116 describe_map_tree (current_global_map, 1, shadow, prefix,
3117 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3118
3119 /* Print the function-key-map translations under this prefix. */
3120 if (!NILP (current_kboard->Vlocal_function_key_map))
3121 describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix,
3122 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3123
3124 UNGCPRO;
3125 return Qnil;
3126 }
3127
3128 /* Insert a description of the key bindings in STARTMAP,
3129 followed by those of all maps reachable through STARTMAP.
3130 If PARTIAL is nonzero, omit certain "uninteresting" commands
3131 (such as `undefined').
3132 If SHADOW is non-nil, it is a list of maps;
3133 don't mention keys which would be shadowed by any of them.
3134 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3135 TITLE, if not 0, is a string to insert at the beginning.
3136 TITLE should not end with a colon or a newline; we supply that.
3137 If NOMENU is not 0, then omit menu-bar commands.
3138
3139 If TRANSL is nonzero, the definitions are actually key translations
3140 so print strings and vectors differently.
3141
3142 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3143 to look through.
3144
3145 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3146 don't omit it; instead, mention it but say it is shadowed. */
3147
3148 void
3149 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3150 always_title, mention_shadow)
3151 Lisp_Object startmap, shadow, prefix;
3152 int partial;
3153 char *title;
3154 int nomenu;
3155 int transl;
3156 int always_title;
3157 int mention_shadow;
3158 {
3159 Lisp_Object maps, orig_maps, seen, sub_shadows;
3160 struct gcpro gcpro1, gcpro2, gcpro3;
3161 int something = 0;
3162 char *key_heading
3163 = "\
3164 key binding\n\
3165 --- -------\n";
3166
3167 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3168 seen = Qnil;
3169 sub_shadows = Qnil;
3170 GCPRO3 (maps, seen, sub_shadows);
3171
3172 if (nomenu)
3173 {
3174 Lisp_Object list;
3175
3176 /* Delete from MAPS each element that is for the menu bar. */
3177 for (list = maps; !NILP (list); list = XCDR (list))
3178 {
3179 Lisp_Object elt, prefix, tem;
3180
3181 elt = Fcar (list);
3182 prefix = Fcar (elt);
3183 if (XVECTOR (prefix)->size >= 1)
3184 {
3185 tem = Faref (prefix, make_number (0));
3186 if (EQ (tem, Qmenu_bar))
3187 maps = Fdelq (elt, maps);
3188 }
3189 }
3190 }
3191
3192 if (!NILP (maps) || always_title)
3193 {
3194 if (title)
3195 {
3196 insert_string (title);
3197 if (!NILP (prefix))
3198 {
3199 insert_string (" Starting With ");
3200 insert1 (Fkey_description (prefix, Qnil));
3201 }
3202 insert_string (":\n");
3203 }
3204 insert_string (key_heading);
3205 something = 1;
3206 }
3207
3208 for (; !NILP (maps); maps = Fcdr (maps))
3209 {
3210 register Lisp_Object elt, prefix, tail;
3211
3212 elt = Fcar (maps);
3213 prefix = Fcar (elt);
3214
3215 sub_shadows = Qnil;
3216
3217 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3218 {
3219 Lisp_Object shmap;
3220
3221 shmap = XCAR (tail);
3222
3223 /* If the sequence by which we reach this keymap is zero-length,
3224 then the shadow map for this keymap is just SHADOW. */
3225 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3226 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3227 ;
3228 /* If the sequence by which we reach this keymap actually has
3229 some elements, then the sequence's definition in SHADOW is
3230 what we should use. */
3231 else
3232 {
3233 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3234 if (INTEGERP (shmap))
3235 shmap = Qnil;
3236 }
3237
3238 /* If shmap is not nil and not a keymap,
3239 it completely shadows this map, so don't
3240 describe this map at all. */
3241 if (!NILP (shmap) && !KEYMAPP (shmap))
3242 goto skip;
3243
3244 if (!NILP (shmap))
3245 sub_shadows = Fcons (shmap, sub_shadows);
3246 }
3247
3248 /* Maps we have already listed in this loop shadow this map. */
3249 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3250 {
3251 Lisp_Object tem;
3252 tem = Fequal (Fcar (XCAR (tail)), prefix);
3253 if (!NILP (tem))
3254 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3255 }
3256
3257 describe_map (Fcdr (elt), prefix,
3258 transl ? describe_translation : describe_command,
3259 partial, sub_shadows, &seen, nomenu, mention_shadow);
3260
3261 skip: ;
3262 }
3263
3264 if (something)
3265 insert_string ("\n");
3266
3267 UNGCPRO;
3268 }
3269
3270 static int previous_description_column;
3271
3272 static void
3273 describe_command (definition, args)
3274 Lisp_Object definition, args;
3275 {
3276 register Lisp_Object tem1;
3277 int column = (int) current_column (); /* iftc */
3278 int description_column;
3279
3280 /* If column 16 is no good, go to col 32;
3281 but don't push beyond that--go to next line instead. */
3282 if (column > 30)
3283 {
3284 insert_char ('\n');
3285 description_column = 32;
3286 }
3287 else if (column > 14 || (column > 10 && previous_description_column == 32))
3288 description_column = 32;
3289 else
3290 description_column = 16;
3291
3292 Findent_to (make_number (description_column), make_number (1));
3293 previous_description_column = description_column;
3294
3295 if (SYMBOLP (definition))
3296 {
3297 tem1 = SYMBOL_NAME (definition);
3298 insert1 (tem1);
3299 insert_string ("\n");
3300 }
3301 else if (STRINGP (definition) || VECTORP (definition))
3302 insert_string ("Keyboard Macro\n");
3303 else if (KEYMAPP (definition))
3304 insert_string ("Prefix Command\n");
3305 else
3306 insert_string ("??\n");
3307 }
3308
3309 static void
3310 describe_translation (definition, args)
3311 Lisp_Object definition, args;
3312 {
3313 register Lisp_Object tem1;
3314
3315 Findent_to (make_number (16), make_number (1));
3316
3317 if (SYMBOLP (definition))
3318 {
3319 tem1 = SYMBOL_NAME (definition);
3320 insert1 (tem1);
3321 insert_string ("\n");
3322 }
3323 else if (STRINGP (definition) || VECTORP (definition))
3324 {
3325 insert1 (Fkey_description (definition, Qnil));
3326 insert_string ("\n");
3327 }
3328 else if (KEYMAPP (definition))
3329 insert_string ("Prefix Command\n");
3330 else
3331 insert_string ("??\n");
3332 }
3333
3334 /* describe_map puts all the usable elements of a sparse keymap
3335 into an array of `struct describe_map_elt',
3336 then sorts them by the events. */
3337
3338 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3339
3340 /* qsort comparison function for sorting `struct describe_map_elt' by
3341 the event field. */
3342
3343 static int
3344 describe_map_compare (aa, bb)
3345 const void *aa, *bb;
3346 {
3347 const struct describe_map_elt *a = aa, *b = bb;
3348 if (INTEGERP (a->event) && INTEGERP (b->event))
3349 return ((XINT (a->event) > XINT (b->event))
3350 - (XINT (a->event) < XINT (b->event)));
3351 if (!INTEGERP (a->event) && INTEGERP (b->event))
3352 return 1;
3353 if (INTEGERP (a->event) && !INTEGERP (b->event))
3354 return -1;
3355 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3356 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3357 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3358 : 0);
3359 return 0;
3360 }
3361
3362 /* Describe the contents of map MAP, assuming that this map itself is
3363 reached by the sequence of prefix keys PREFIX (a string or vector).
3364 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3365
3366 static void
3367 describe_map (map, prefix, elt_describer, partial, shadow,
3368 seen, nomenu, mention_shadow)
3369 register Lisp_Object map;
3370 Lisp_Object prefix;
3371 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3372 int partial;
3373 Lisp_Object shadow;
3374 Lisp_Object *seen;
3375 int nomenu;
3376 int mention_shadow;
3377 {
3378 Lisp_Object tail, definition, event;
3379 Lisp_Object tem;
3380 Lisp_Object suppress;
3381 Lisp_Object kludge;
3382 int first = 1;
3383 struct gcpro gcpro1, gcpro2, gcpro3;
3384
3385 /* These accumulate the values from sparse keymap bindings,
3386 so we can sort them and handle them in order. */
3387 int length_needed = 0;
3388 struct describe_map_elt *vect;
3389 int slots_used = 0;
3390 int i;
3391
3392 suppress = Qnil;
3393
3394 if (partial)
3395 suppress = intern ("suppress-keymap");
3396
3397 /* This vector gets used to present single keys to Flookup_key. Since
3398 that is done once per keymap element, we don't want to cons up a
3399 fresh vector every time. */
3400 kludge = Fmake_vector (make_number (1), Qnil);
3401 definition = Qnil;
3402
3403 for (tail = map; CONSP (tail); tail = XCDR (tail))
3404 length_needed++;
3405
3406 vect = ((struct describe_map_elt *)
3407 alloca (sizeof (struct describe_map_elt) * length_needed));
3408
3409 GCPRO3 (prefix, definition, kludge);
3410
3411 for (tail = map; CONSP (tail); tail = XCDR (tail))
3412 {
3413 QUIT;
3414
3415 if (VECTORP (XCAR (tail))
3416 || CHAR_TABLE_P (XCAR (tail)))
3417 describe_vector (XCAR (tail),
3418 prefix, Qnil, elt_describer, partial, shadow, map,
3419 (int *)0, 0, 1, mention_shadow);
3420 else if (CONSP (XCAR (tail)))
3421 {
3422 int this_shadowed = 0;
3423
3424 event = XCAR (XCAR (tail));
3425
3426 /* Ignore bindings whose "prefix" are not really valid events.
3427 (We get these in the frames and buffers menu.) */
3428 if (!(SYMBOLP (event) || INTEGERP (event)))
3429 continue;
3430
3431 if (nomenu && EQ (event, Qmenu_bar))
3432 continue;
3433
3434 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3435
3436 /* Don't show undefined commands or suppressed commands. */
3437 if (NILP (definition)) continue;
3438 if (SYMBOLP (definition) && partial)
3439 {
3440 tem = Fget (definition, suppress);
3441 if (!NILP (tem))
3442 continue;
3443 }
3444
3445 /* Don't show a command that isn't really visible
3446 because a local definition of the same key shadows it. */
3447
3448 ASET (kludge, 0, event);
3449 if (!NILP (shadow))
3450 {
3451 tem = shadow_lookup (shadow, kludge, Qt);
3452 if (!NILP (tem))
3453 {
3454 /* If both bindings are keymaps, this key is a prefix key,
3455 so don't say it is shadowed. */
3456 if (KEYMAPP (definition) && KEYMAPP (tem))
3457 ;
3458 /* Avoid generating duplicate entries if the
3459 shadowed binding has the same definition. */
3460 else if (mention_shadow && !EQ (tem, definition))
3461 this_shadowed = 1;
3462 else
3463 continue;
3464 }
3465 }
3466
3467 tem = Flookup_key (map, kludge, Qt);
3468 if (!EQ (tem, definition)) continue;
3469
3470 vect[slots_used].event = event;
3471 vect[slots_used].definition = definition;
3472 vect[slots_used].shadowed = this_shadowed;
3473 slots_used++;
3474 }
3475 else if (EQ (XCAR (tail), Qkeymap))
3476 {
3477 /* The same keymap might be in the structure twice, if we're
3478 using an inherited keymap. So skip anything we've already
3479 encountered. */
3480 tem = Fassq (tail, *seen);
3481 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3482 break;
3483 *seen = Fcons (Fcons (tail, prefix), *seen);
3484 }
3485 }
3486
3487 /* If we found some sparse map events, sort them. */
3488
3489 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3490 describe_map_compare);
3491
3492 /* Now output them in sorted order. */
3493
3494 for (i = 0; i < slots_used; i++)
3495 {
3496 Lisp_Object start, end;
3497
3498 if (first)
3499 {
3500 previous_description_column = 0;
3501 insert ("\n", 1);
3502 first = 0;
3503 }
3504
3505 ASET (kludge, 0, vect[i].event);
3506 start = vect[i].event;
3507 end = start;
3508
3509 definition = vect[i].definition;
3510
3511 /* Find consecutive chars that are identically defined. */
3512 if (INTEGERP (vect[i].event))
3513 {
3514 while (i + 1 < slots_used
3515 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3516 && !NILP (Fequal (vect[i + 1].definition, definition))
3517 && vect[i].shadowed == vect[i + 1].shadowed)
3518 i++;
3519 end = vect[i].event;
3520 }
3521
3522 /* Now START .. END is the range to describe next. */
3523
3524 /* Insert the string to describe the event START. */
3525 insert1 (Fkey_description (kludge, prefix));
3526
3527 if (!EQ (start, end))
3528 {
3529 insert (" .. ", 4);
3530
3531 ASET (kludge, 0, end);
3532 /* Insert the string to describe the character END. */
3533 insert1 (Fkey_description (kludge, prefix));
3534 }
3535
3536 /* Print a description of the definition of this character.
3537 elt_describer will take care of spacing out far enough
3538 for alignment purposes. */
3539 (*elt_describer) (vect[i].definition, Qnil);
3540
3541 if (vect[i].shadowed)
3542 {
3543 SET_PT (PT - 1);
3544 insert_string ("\n (that binding is currently shadowed by another mode)");
3545 SET_PT (PT + 1);
3546 }
3547 }
3548
3549 UNGCPRO;
3550 }
3551
3552 static void
3553 describe_vector_princ (elt, fun)
3554 Lisp_Object elt, fun;
3555 {
3556 Findent_to (make_number (16), make_number (1));
3557 call1 (fun, elt);
3558 Fterpri (Qnil);
3559 }
3560
3561 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3562 doc: /* Insert a description of contents of VECTOR.
3563 This is text showing the elements of vector matched against indices.
3564 DESCRIBER is the output function used; nil means use `princ'. */)
3565 (vector, describer)
3566 Lisp_Object vector, describer;
3567 {
3568 int count = SPECPDL_INDEX ();
3569 if (NILP (describer))
3570 describer = intern ("princ");
3571 specbind (Qstandard_output, Fcurrent_buffer ());
3572 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3573 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3574 Qnil, Qnil, (int *)0, 0, 0, 0);
3575
3576 return unbind_to (count, Qnil);
3577 }
3578
3579 /* Insert in the current buffer a description of the contents of VECTOR.
3580 We call ELT_DESCRIBER to insert the description of one value found
3581 in VECTOR.
3582
3583 ELT_PREFIX describes what "comes before" the keys or indices defined
3584 by this vector. This is a human-readable string whose size
3585 is not necessarily related to the situation.
3586
3587 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3588 leads to this keymap.
3589
3590 If the vector is a chartable, ELT_PREFIX is the vector
3591 of bytes that lead to the character set or portion of a character
3592 set described by this chartable.
3593
3594 If PARTIAL is nonzero, it means do not mention suppressed commands
3595 (that assumes the vector is in a keymap).
3596
3597 SHADOW is a list of keymaps that shadow this map.
3598 If it is non-nil, then we look up the key in those maps
3599 and we don't mention it now if it is defined by any of them.
3600
3601 ENTIRE_MAP is the keymap in which this vector appears.
3602 If the definition in effect in the whole map does not match
3603 the one in this vector, we ignore this one.
3604
3605 When describing a sub-char-table, INDICES is a list of
3606 indices at higher levels in this char-table,
3607 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3608
3609 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3610
3611 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3612
3613 static void
3614 describe_vector (vector, prefix, args, elt_describer,
3615 partial, shadow, entire_map,
3616 indices, char_table_depth, keymap_p,
3617 mention_shadow)
3618 register Lisp_Object vector;
3619 Lisp_Object prefix, args;
3620 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3621 int partial;
3622 Lisp_Object shadow;
3623 Lisp_Object entire_map;
3624 int *indices;
3625 int char_table_depth;
3626 int keymap_p;
3627 int mention_shadow;
3628 {
3629 Lisp_Object definition;
3630 Lisp_Object tem2;
3631 Lisp_Object elt_prefix = Qnil;
3632 register int i;
3633 Lisp_Object suppress;
3634 Lisp_Object kludge;
3635 int first = 1;
3636 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3637 /* Range of elements to be handled. */
3638 int from, to;
3639 /* A flag to tell if a leaf in this level of char-table is not a
3640 generic character (i.e. a complete multibyte character). */
3641 int complete_char;
3642 int character;
3643 int starting_i;
3644
3645 suppress = Qnil;
3646
3647 if (indices == 0)
3648 indices = (int *) alloca (3 * sizeof (int));
3649
3650 definition = Qnil;
3651
3652 if (!keymap_p)
3653 {
3654 /* Call Fkey_description first, to avoid GC bug for the other string. */
3655 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3656 {
3657 Lisp_Object tem;
3658 tem = Fkey_description (prefix, Qnil);
3659 elt_prefix = concat2 (tem, build_string (" "));
3660 }
3661 prefix = Qnil;
3662 }
3663
3664 /* This vector gets used to present single keys to Flookup_key. Since
3665 that is done once per vector element, we don't want to cons up a
3666 fresh vector every time. */
3667 kludge = Fmake_vector (make_number (1), Qnil);
3668 GCPRO4 (elt_prefix, prefix, definition, kludge);
3669
3670 if (partial)
3671 suppress = intern ("suppress-keymap");
3672
3673 if (CHAR_TABLE_P (vector))
3674 {
3675 if (char_table_depth == 0)
3676 {
3677 /* VECTOR is a top level char-table. */
3678 complete_char = 1;
3679 from = 0;
3680 to = CHAR_TABLE_ORDINARY_SLOTS;
3681 }
3682 else
3683 {
3684 /* VECTOR is a sub char-table. */
3685 if (char_table_depth >= 3)
3686 /* A char-table is never that deep. */
3687 error ("Too deep char table");
3688
3689 complete_char
3690 = (CHARSET_VALID_P (indices[0])
3691 && ((CHARSET_DIMENSION (indices[0]) == 1
3692 && char_table_depth == 1)
3693 || char_table_depth == 2));
3694
3695 /* Meaningful elements are from 32th to 127th. */
3696 from = 32;
3697 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3698 }
3699 }
3700 else
3701 {
3702 /* This does the right thing for ordinary vectors. */
3703
3704 complete_char = 1;
3705 from = 0;
3706 to = XVECTOR (vector)->size;
3707 }
3708
3709 for (i = from; i < to; i++)
3710 {
3711 int this_shadowed = 0;
3712 QUIT;
3713
3714 if (CHAR_TABLE_P (vector))
3715 {
3716 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3717 complete_char = 0;
3718
3719 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3720 && !CHARSET_DEFINED_P (i - 128))
3721 continue;
3722
3723 definition
3724 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3725 }
3726 else
3727 definition = get_keyelt (AREF (vector, i), 0);
3728
3729 if (NILP (definition)) continue;
3730
3731 /* Don't mention suppressed commands. */
3732 if (SYMBOLP (definition) && partial)
3733 {
3734 Lisp_Object tem;
3735
3736 tem = Fget (definition, suppress);
3737
3738 if (!NILP (tem)) continue;
3739 }
3740
3741 /* Set CHARACTER to the character this entry describes, if any.
3742 Also update *INDICES. */
3743 if (CHAR_TABLE_P (vector))
3744 {
3745 indices[char_table_depth] = i;
3746
3747 if (char_table_depth == 0)
3748 {
3749 character = i;
3750 indices[0] = i - 128;
3751 }
3752 else if (complete_char)
3753 {
3754 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3755 }
3756 else
3757 character = 0;
3758 }
3759 else
3760 character = i;
3761
3762 ASET (kludge, 0, make_number (character));
3763
3764 /* If this binding is shadowed by some other map, ignore it. */
3765 if (!NILP (shadow) && complete_char)
3766 {
3767 Lisp_Object tem;
3768
3769 tem = shadow_lookup (shadow, kludge, Qt);
3770
3771 if (!NILP (tem))
3772 {
3773 if (mention_shadow)
3774 this_shadowed = 1;
3775 else
3776 continue;
3777 }
3778 }
3779
3780 /* Ignore this definition if it is shadowed by an earlier
3781 one in the same keymap. */
3782 if (!NILP (entire_map) && complete_char)
3783 {
3784 Lisp_Object tem;
3785
3786 tem = Flookup_key (entire_map, kludge, Qt);
3787
3788 if (!EQ (tem, definition))
3789 continue;
3790 }
3791
3792 if (first)
3793 {
3794 if (char_table_depth == 0)
3795 insert ("\n", 1);
3796 first = 0;
3797 }
3798
3799 /* For a sub char-table, show the depth by indentation.
3800 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3801 if (char_table_depth > 0)
3802 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3803
3804 /* Output the prefix that applies to every entry in this map. */
3805 if (!NILP (elt_prefix))
3806 insert1 (elt_prefix);
3807
3808 /* Insert or describe the character this slot is for,
3809 or a description of what it is for. */
3810 if (SUB_CHAR_TABLE_P (vector))
3811 {
3812 if (complete_char)
3813 insert_char (character);
3814 else
3815 {
3816 /* We need an octal representation for this block of
3817 characters. */
3818 char work[16];
3819 sprintf (work, "(row %d)", i);
3820 insert (work, strlen (work));
3821 }
3822 }
3823 else if (CHAR_TABLE_P (vector))
3824 {
3825 if (complete_char)
3826 insert1 (Fkey_description (kludge, prefix));
3827 else
3828 {
3829 /* Print the information for this character set. */
3830 insert_string ("<");
3831 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3832 if (STRINGP (tem2))
3833 insert_from_string (tem2, 0, 0, SCHARS (tem2),
3834 SBYTES (tem2), 0);
3835 else
3836 insert ("?", 1);
3837 insert (">", 1);
3838 }
3839 }
3840 else
3841 {
3842 insert1 (Fkey_description (kludge, prefix));
3843 }
3844
3845 /* If we find a sub char-table within a char-table,
3846 scan it recursively; it defines the details for
3847 a character set or a portion of a character set. */
3848 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3849 {
3850 insert ("\n", 1);
3851 describe_vector (definition, prefix, args, elt_describer,
3852 partial, shadow, entire_map,
3853 indices, char_table_depth + 1, keymap_p,
3854 mention_shadow);
3855 continue;
3856 }
3857
3858 starting_i = i;
3859
3860 /* Find all consecutive characters or rows that have the same
3861 definition. But, for elements of a top level char table, if
3862 they are for charsets, we had better describe one by one even
3863 if they have the same definition. */
3864 if (CHAR_TABLE_P (vector))
3865 {
3866 int limit = to;
3867
3868 if (char_table_depth == 0)
3869 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3870
3871 while (i + 1 < limit
3872 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3873 !NILP (tem2))
3874 && !NILP (Fequal (tem2, definition)))
3875 i++;
3876 }
3877 else
3878 while (i + 1 < to
3879 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3880 !NILP (tem2))
3881 && !NILP (Fequal (tem2, definition)))
3882 i++;
3883
3884
3885 /* If we have a range of more than one character,
3886 print where the range reaches to. */
3887
3888 if (i != starting_i)
3889 {
3890 insert (" .. ", 4);
3891
3892 ASET (kludge, 0, make_number (i));
3893
3894 if (!NILP (elt_prefix))
3895 insert1 (elt_prefix);
3896
3897 if (CHAR_TABLE_P (vector))
3898 {
3899 if (char_table_depth == 0)
3900 {
3901 insert1 (Fkey_description (kludge, prefix));
3902 }
3903 else if (complete_char)
3904 {
3905 indices[char_table_depth] = i;
3906 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3907 insert_char (character);
3908 }
3909 else
3910 {
3911 /* We need an octal representation for this block of
3912 characters. */
3913 char work[16];
3914 sprintf (work, "(row %d)", i);
3915 insert (work, strlen (work));
3916 }
3917 }
3918 else
3919 {
3920 insert1 (Fkey_description (kludge, prefix));
3921 }
3922 }
3923
3924 /* Print a description of the definition of this character.
3925 elt_describer will take care of spacing out far enough
3926 for alignment purposes. */
3927 (*elt_describer) (definition, args);
3928
3929 if (this_shadowed)
3930 {
3931 SET_PT (PT - 1);
3932 insert_string (" (binding currently shadowed)");
3933 SET_PT (PT + 1);
3934 }
3935 }
3936
3937 /* For (sub) char-table, print `defalt' slot at last. */
3938 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3939 {
3940 insert (" ", char_table_depth * 2);
3941 insert_string ("<<default>>");
3942 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3943 }
3944
3945 UNGCPRO;
3946 }
3947 \f
3948 /* Apropos - finding all symbols whose names match a regexp. */
3949 static Lisp_Object apropos_predicate;
3950 static Lisp_Object apropos_accumulate;
3951
3952 static void
3953 apropos_accum (symbol, string)
3954 Lisp_Object symbol, string;
3955 {
3956 register Lisp_Object tem;
3957
3958 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3959 if (!NILP (tem) && !NILP (apropos_predicate))
3960 tem = call1 (apropos_predicate, symbol);
3961 if (!NILP (tem))
3962 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3963 }
3964
3965 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3966 doc: /* Show all symbols whose names contain match for REGEXP.
3967 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3968 for each symbol and a symbol is mentioned only if that returns non-nil.
3969 Return list of symbols found. */)
3970 (regexp, predicate)
3971 Lisp_Object regexp, predicate;
3972 {
3973 Lisp_Object tem;
3974 CHECK_STRING (regexp);
3975 apropos_predicate = predicate;
3976 apropos_accumulate = Qnil;
3977 map_obarray (Vobarray, apropos_accum, regexp);
3978 tem = Fsort (apropos_accumulate, Qstring_lessp);
3979 apropos_accumulate = Qnil;
3980 apropos_predicate = Qnil;
3981 return tem;
3982 }
3983 \f
3984 void
3985 syms_of_keymap ()
3986 {
3987 Qkeymap = intern ("keymap");
3988 staticpro (&Qkeymap);
3989 staticpro (&apropos_predicate);
3990 staticpro (&apropos_accumulate);
3991 apropos_predicate = Qnil;
3992 apropos_accumulate = Qnil;
3993
3994 /* Now we are ready to set up this property, so we can
3995 create char tables. */
3996 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3997
3998 /* Initialize the keymaps standardly used.
3999 Each one is the value of a Lisp variable, and is also
4000 pointed to by a C variable */
4001
4002 global_map = Fmake_keymap (Qnil);
4003 Fset (intern ("global-map"), global_map);
4004
4005 current_global_map = global_map;
4006 staticpro (&global_map);
4007 staticpro (&current_global_map);
4008
4009 meta_map = Fmake_keymap (Qnil);
4010 Fset (intern ("esc-map"), meta_map);
4011 Ffset (intern ("ESC-prefix"), meta_map);
4012
4013 control_x_map = Fmake_keymap (Qnil);
4014 Fset (intern ("ctl-x-map"), control_x_map);
4015 Ffset (intern ("Control-X-prefix"), control_x_map);
4016
4017 exclude_keys
4018 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
4019 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
4020 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
4021 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
4022 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
4023 Qnil)))));
4024 staticpro (&exclude_keys);
4025
4026 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
4027 doc: /* List of commands given new key bindings recently.
4028 This is used for internal purposes during Emacs startup;
4029 don't alter it yourself. */);
4030 Vdefine_key_rebound_commands = Qt;
4031
4032 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
4033 doc: /* Default keymap to use when reading from the minibuffer. */);
4034 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
4035
4036 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
4037 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
4038 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
4039 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
4040
4041 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
4042 doc: /* Local keymap for minibuffer input with completion. */);
4043 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
4044 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
4045
4046 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
4047 &Vminibuffer_local_filename_completion_map,
4048 doc: /* Local keymap for minibuffer input with completion for filenames. */);
4049 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
4050 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
4051 Vminibuffer_local_completion_map);
4052
4053
4054 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
4055 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
4056 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
4057 Fset_keymap_parent (Vminibuffer_local_must_match_map,
4058 Vminibuffer_local_completion_map);
4059
4060 DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
4061 &Vminibuffer_local_must_match_filename_map,
4062 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
4063 Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
4064 Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
4065 Vminibuffer_local_must_match_map);
4066
4067 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4068 doc: /* Alist of keymaps to use for minor modes.
4069 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4070 key sequences and look up bindings if VARIABLE's value is non-nil.
4071 If two active keymaps bind the same key, the keymap appearing earlier
4072 in the list takes precedence. */);
4073 Vminor_mode_map_alist = Qnil;
4074
4075 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4076 doc: /* Alist of keymaps to use for minor modes, in current major mode.
4077 This variable is an alist just like `minor-mode-map-alist', and it is
4078 used the same way (and before `minor-mode-map-alist'); however,
4079 it is provided for major modes to bind locally. */);
4080 Vminor_mode_overriding_map_alist = Qnil;
4081
4082 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4083 doc: /* List of keymap alists to use for emulations modes.
4084 It is intended for modes or packages using multiple minor-mode keymaps.
4085 Each element is a keymap alist just like `minor-mode-map-alist', or a
4086 symbol with a variable binding which is a keymap alist, and it is used
4087 the same way. The "active" keymaps in each alist are used before
4088 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
4089 Vemulation_mode_map_alists = Qnil;
4090
4091 staticpro (&Vmouse_events);
4092 Vmouse_events = Fcons (intern ("menu-bar"),
4093 Fcons (intern ("tool-bar"),
4094 Fcons (intern ("header-line"),
4095 Fcons (intern ("mode-line"),
4096 Fcons (intern ("mouse-1"),
4097 Fcons (intern ("mouse-2"),
4098 Fcons (intern ("mouse-3"),
4099 Fcons (intern ("mouse-4"),
4100 Fcons (intern ("mouse-5"),
4101 Qnil)))))))));
4102
4103
4104 Qsingle_key_description = intern ("single-key-description");
4105 staticpro (&Qsingle_key_description);
4106
4107 Qkey_description = intern ("key-description");
4108 staticpro (&Qkey_description);
4109
4110 Qkeymapp = intern ("keymapp");
4111 staticpro (&Qkeymapp);
4112
4113 Qnon_ascii = intern ("non-ascii");
4114 staticpro (&Qnon_ascii);
4115
4116 Qmenu_item = intern ("menu-item");
4117 staticpro (&Qmenu_item);
4118
4119 Qremap = intern ("remap");
4120 staticpro (&Qremap);
4121
4122 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4123 staticpro (&command_remapping_vector);
4124
4125 where_is_cache_keymaps = Qt;
4126 where_is_cache = Qnil;
4127 staticpro (&where_is_cache);
4128 staticpro (&where_is_cache_keymaps);
4129
4130 defsubr (&Skeymapp);
4131 defsubr (&Skeymap_parent);
4132 defsubr (&Skeymap_prompt);
4133 defsubr (&Sset_keymap_parent);
4134 defsubr (&Smake_keymap);
4135 defsubr (&Smake_sparse_keymap);
4136 defsubr (&Smap_keymap);
4137 defsubr (&Scopy_keymap);
4138 defsubr (&Scommand_remapping);
4139 defsubr (&Skey_binding);
4140 defsubr (&Slocal_key_binding);
4141 defsubr (&Sglobal_key_binding);
4142 defsubr (&Sminor_mode_key_binding);
4143 defsubr (&Sdefine_key);
4144 defsubr (&Slookup_key);
4145 defsubr (&Sdefine_prefix_command);
4146 defsubr (&Suse_global_map);
4147 defsubr (&Suse_local_map);
4148 defsubr (&Scurrent_local_map);
4149 defsubr (&Scurrent_global_map);
4150 defsubr (&Scurrent_minor_mode_maps);
4151 defsubr (&Scurrent_active_maps);
4152 defsubr (&Saccessible_keymaps);
4153 defsubr (&Skey_description);
4154 defsubr (&Sdescribe_vector);
4155 defsubr (&Ssingle_key_description);
4156 defsubr (&Stext_char_description);
4157 defsubr (&Swhere_is_internal);
4158 defsubr (&Sdescribe_buffer_bindings);
4159 defsubr (&Sapropos_internal);
4160 }
4161
4162 void
4163 keys_of_keymap ()
4164 {
4165 initial_define_key (global_map, 033, "ESC-prefix");
4166 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
4167 }
4168
4169 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4170 (do not change this comment) */