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