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