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