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