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