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