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