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