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