Initial git import
[sxemacs] / src / ui / keymap.c
1 /* Manipulation of keymaps
2    Copyright (C) 1985, 1991-1995 Free Software Foundation, Inc.
3    Copyright (C) 1995 Board of Trustees, University of Illinois.
4    Copyright (C) 1995 Sun Microsystems, Inc.
5    Copyright (C) 2007 Steve Youngs.
6    Totally redesigned by jwz in 1991.
7
8 This file is part of SXEmacs
9
10 SXEmacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
14
15 SXEmacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 GNU General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
22
23
24 /* Synched up with: Mule 2.0.  Not synched with FSF.  Substantially
25    different from FSF. */
26
27 #include <config.h>
28 #include "lisp.h"
29
30 #include "buffer.h"
31 #include "bytecode.h"
32 #include "console.h"
33 #include "elhash.h"
34 #define INCLUDE_EVENTS_H_PRIVATE_SPHERE
35 #include "events/events.h"
36 #include "frame.h"
37 #include "insdel.h"
38 #include "keymap.h"
39 #include "window.h"
40 #include "events/events-mod.h"
41 \f
42 /* A keymap contains six slots:
43
44    parents         Ordered list of keymaps to search after
45                    this one if no match is found.
46                    Keymaps can thus be arranged in a hierarchy.
47
48    table           A hash table, hashing keysyms to their bindings.
49                    It will be one of the following:
50
51                    -- a symbol, e.g. 'home
52                    -- a character, representing something printable
53                       (not ?\C-c meaning C-c, for instance)
54                    -- an integer representing a modifier combination
55
56    inverse_table   A hash table, hashing bindings to the list of keysyms
57                    in this keymap which are bound to them.  This is to make
58                    the Fwhere_is_internal() function be fast.  It needs to be
59                    fast because we want to be able to call it in realtime to
60                    update the keyboard-equivalents on the pulldown menus.
61                    Values of the table are either atoms (keysyms)
62                    or a dotted list of keysyms.
63
64    sub_maps_cache  An alist; for each entry in this keymap whose binding is
65                    a keymap (that is, Fkeymapp()) this alist associates that
66                    keysym with that binding.  This is used to optimize both
67                    Fwhere_is_internal() and Faccessible_keymaps().  This slot
68                    gets set to the symbol `t' every time a change is made to
69                    this keymap, causing it to be recomputed when next needed.
70
71    prompt          See `set-keymap-prompt'.
72
73    default_binding See `set-keymap-default-binding'.
74
75    Sequences of keys are stored in the obvious way: if the sequence of keys
76    "abc" was bound to some command `foo', the hierarchy would look like
77
78       keymap-1: associates "a" with keymap-2
79       keymap-2: associates "b" with keymap-3
80       keymap-3: associates "c" with foo
81
82    However, bucky bits ("modifiers" to the X-minded) are represented in the
83    keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
84    Each combination of modifiers (e.g. control-hyper) gets its own submap
85    off of the main map.  The hash key for a modifier combination is
86    an integer, computed by MAKE_MODIFIER_HASH_KEY().
87
88    If the key `C-a' was bound to some command, the hierarchy would look like
89
90       keymap-1: associates the integer XEMACS_MOD_CONTROL with keymap-2
91       keymap-2: associates "a" with the command
92
93    Similarly, if the key `C-H-a' was bound to some command, the hierarchy
94    would look like
95
96       keymap-1: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
97                 with keymap-2
98       keymap-2: associates "a" with the command
99
100    Note that a special exception is made for the meta modifier, in order
101    to deal with ESC/meta lossage.  Any key combination containing the
102    meta modifier is first indexed off of the main map into the meta
103    submap (with hash key XEMACS_MOD_META) and then indexed off of the
104    meta submap with the meta modifier removed from the key combination.
105    For example, when associating a command with C-M-H-a, we'd have
106
107       keymap-1: associates the integer XEMACS_MOD_META with keymap-2
108       keymap-2: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
109                 with keymap-3
110       keymap-3: associates "a" with the command
111
112    Note that keymap-2 might have normal bindings in it; these would be
113    for key combinations containing only the meta modifier, such as
114    M-y or meta-backspace.
115
116    If the command that "a" was bound to in keymap-3 was itself a keymap,
117    then that would make the key "C-M-H-a" be a prefix character.
118
119    Note that this new model of keymaps takes much of the magic away from
120    the Escape key: the value of the variable `esc-map' is no longer indexed
121    in the `global-map' under the ESC key.  It's indexed under the integer
122    XEMACS_MOD_META.  This is not user-visible, however; none of the "bucky"
123    maps are.
124
125    There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
126    and (define-key some-random-map "\^[" my-esc-map) work as before, for
127    compatibility.
128
129    Since keymaps are opaque, the only way to extract information from them
130    is with the functions lookup-key, key-binding, local-key-binding, and
131    global-key-binding, which work just as before, and the new function
132    map-keymap, which is roughly analogous to maphash.
133
134    Note that map-keymap perpetuates the illusion that the "bucky" submaps
135    don't exist: if you map over a keymap with bucky submaps, it will also
136    map over those submaps.  It does not, however, map over other random
137    submaps of the keymap, just the bucky ones.
138
139    One implication of this is that when you map over `global-map', you will
140    also map over `esc-map'.  It is merely for compatibility that the esc-map
141    is accessible at all; I think that's a bad thing, since it blurs the
142    distinction between ESC and "meta" even more.  "M-x" is no more a two-
143    key sequence than "C-x" is.
144
145  */
146
147 struct Lisp_Keymap {
148         struct lcrecord_header header;
149         Lisp_Object parents;    /* Keymaps to be searched after this one.
150                                    An ordered list */
151         Lisp_Object prompt;     /* Qnil or a string to print in the minibuffer
152                                    when reading from this keymap */
153         Lisp_Object table;      /* The contents of this keymap */
154         Lisp_Object inverse_table;      /* The inverse mapping of the above */
155         Lisp_Object default_binding;    /* Use this if no other binding is found
156                                            (this overrides parent maps and the
157                                            normal global-map lookup). */
158         Lisp_Object sub_maps_cache;     /* Cache of directly inferior keymaps;
159                                            This holds an alist, of the key and the
160                                            maps, or the modifier bit and the map.
161                                            If this is the symbol t, then the cache
162                                            needs to be recomputed. */
163         Lisp_Object name;       /* Just for debugging convenience */
164 };
165
166 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
167 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
168 \f
169 /* Actually allocate storage for these variables */
170
171 Lisp_Object Vcurrent_global_map;        /* Always a keymap */
172
173 static Lisp_Object Vglobal_tty_map, Vglobal_window_system_map;
174
175 static Lisp_Object Vmouse_grabbed_buffer;
176
177 /* Alist of minor mode variables and keymaps.  */
178 static Lisp_Object Qminor_mode_map_alist;
179
180 static Lisp_Object Voverriding_local_map;
181
182 static Lisp_Object Vkey_translation_map;
183
184 static Lisp_Object Vvertical_divider_map;
185
186 /* This is incremented whenever a change is made to a keymap.  This is
187    so that things which care (such as the menubar code) can recompute
188    privately-cached data when the user has changed keybindings.
189  */
190 Fixnum keymap_tick;
191
192 /* Prefixing a key with this character is the same as sending a meta bit. */
193 Lisp_Object Vmeta_prefix_char;
194
195 Lisp_Object Qkeymapp;
196 Lisp_Object Vsingle_space_string;
197 Lisp_Object Qsuppress_keymap;
198 Lisp_Object Qmodeline_map;
199 Lisp_Object Qtoolbar_map;
200
201 EXFUN(Fkeymap_fullness, 1);
202 EXFUN(Fset_keymap_name, 2);
203 EXFUN(Fsingle_key_description, 1);
204
205 static void describe_command(Lisp_Object definition, Lisp_Object buffer);
206 static void describe_map(Lisp_Object keymap, Lisp_Object elt_prefix,
207                          void (*elt_describer) (Lisp_Object, Lisp_Object),
208                          int partial,
209                          Lisp_Object shadow,
210                          int mice_only_p, Lisp_Object buffer);
211 static Lisp_Object keymap_submaps(Lisp_Object keymap);
212
213 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
214 Lisp_Object Qbutton0;
215 Lisp_Object Qbutton1, Qbutton2, Qbutton3, Qbutton4, Qbutton5;
216 Lisp_Object Qbutton6, Qbutton7, Qbutton8, Qbutton9, Qbutton10;
217 Lisp_Object Qbutton11, Qbutton12, Qbutton13, Qbutton14, Qbutton15;
218 Lisp_Object Qbutton16, Qbutton17, Qbutton18, Qbutton19, Qbutton20;
219 Lisp_Object Qbutton21, Qbutton22, Qbutton23, Qbutton24, Qbutton25;
220 Lisp_Object Qbutton26, Qbutton27, Qbutton28, Qbutton29, Qbutton30;
221 Lisp_Object Qbutton31, Qbutton32;
222 Lisp_Object Qbutton0up;
223 Lisp_Object Qbutton1up, Qbutton2up, Qbutton3up, Qbutton4up, Qbutton5up;
224 Lisp_Object Qbutton6up, Qbutton7up, Qbutton8up, Qbutton9up, Qbutton10up;
225 Lisp_Object Qbutton11up, Qbutton12up, Qbutton13up, Qbutton14up, Qbutton15up;
226 Lisp_Object Qbutton16up, Qbutton17up, Qbutton18up, Qbutton19up, Qbutton20up;
227 Lisp_Object Qbutton21up, Qbutton22up, Qbutton23up, Qbutton24up, Qbutton25up;
228 Lisp_Object Qbutton26up, Qbutton27up, Qbutton28up, Qbutton29up, Qbutton30up;
229 Lisp_Object Qbutton31up, Qbutton32up;
230
231 Lisp_Object Qmenu_selection;
232 /* Emacs compatibility */
233 Lisp_Object Qdown_mouse_1, Qmouse_1;
234 Lisp_Object Qdown_mouse_2, Qmouse_2;
235 Lisp_Object Qdown_mouse_3, Qmouse_3;
236 Lisp_Object Qdown_mouse_4, Qmouse_4;
237 Lisp_Object Qdown_mouse_5, Qmouse_5;
238 Lisp_Object Qdown_mouse_6, Qmouse_6;
239 Lisp_Object Qdown_mouse_7, Qmouse_7;
240 Lisp_Object Qdown_mouse_8, Qmouse_8;
241 Lisp_Object Qdown_mouse_9, Qmouse_9;
242 Lisp_Object Qdown_mouse_10, Qmouse_10;
243 Lisp_Object Qdown_mouse_11, Qmouse_11;
244 Lisp_Object Qdown_mouse_12, Qmouse_12;
245 Lisp_Object Qdown_mouse_13, Qmouse_13;
246 Lisp_Object Qdown_mouse_14, Qmouse_14;
247 Lisp_Object Qdown_mouse_15, Qmouse_15;
248 Lisp_Object Qdown_mouse_16, Qmouse_16;
249 Lisp_Object Qdown_mouse_17, Qmouse_17;
250 Lisp_Object Qdown_mouse_18, Qmouse_18;
251 Lisp_Object Qdown_mouse_19, Qmouse_19;
252 Lisp_Object Qdown_mouse_20, Qmouse_20;
253 Lisp_Object Qdown_mouse_21, Qmouse_21;
254 Lisp_Object Qdown_mouse_22, Qmouse_22;
255 Lisp_Object Qdown_mouse_23, Qmouse_23;
256 Lisp_Object Qdown_mouse_24, Qmouse_24;
257 Lisp_Object Qdown_mouse_25, Qmouse_25;
258 Lisp_Object Qdown_mouse_26, Qmouse_26;
259 Lisp_Object Qdown_mouse_27, Qmouse_27;
260 Lisp_Object Qdown_mouse_28, Qmouse_28;
261 Lisp_Object Qdown_mouse_29, Qmouse_29;
262 Lisp_Object Qdown_mouse_30, Qmouse_30;
263 Lisp_Object Qdown_mouse_31, Qmouse_31;
264 Lisp_Object Qdown_mouse_32, Qmouse_32;
265
266 /* Kludge kludge kludge */
267 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
268 \f
269 /************************************************************************/
270 /*                     The keymap Lisp object                           */
271 /************************************************************************/
272
273 static Lisp_Object mark_keymap(Lisp_Object obj)
274 {
275         Lisp_Keymap *keymap = XKEYMAP(obj);
276         mark_object(keymap->parents);
277         mark_object(keymap->prompt);
278         mark_object(keymap->inverse_table);
279         mark_object(keymap->sub_maps_cache);
280         mark_object(keymap->default_binding);
281         mark_object(keymap->name);
282         return keymap->table;
283 }
284
285 static void
286 print_keymap(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
287 {
288         /* This function can GC */
289         Lisp_Keymap *keymap = XKEYMAP(obj);
290         char buf[200];
291         if (print_readably)
292                 error("printing unreadable object #<keymap 0x%x>",
293                       keymap->header.uid);
294         write_c_string("#<keymap ", printcharfun);
295         if (!NILP(keymap->name)) {
296                 print_internal(keymap->name, printcharfun, 1);
297                 write_c_string(" ", printcharfun);
298         }
299         sprintf(buf, "size %ld 0x%x>",
300                 (long)XINT(Fkeymap_fullness(obj)), keymap->header.uid);
301         write_c_string(buf, printcharfun);
302 }
303
304 static const struct lrecord_description keymap_description[] = {
305         {XD_LISP_OBJECT, offsetof(Lisp_Keymap, parents)},
306         {XD_LISP_OBJECT, offsetof(Lisp_Keymap, prompt)},
307         {XD_LISP_OBJECT, offsetof(Lisp_Keymap, table)},
308         {XD_LISP_OBJECT, offsetof(Lisp_Keymap, inverse_table)},
309         {XD_LISP_OBJECT, offsetof(Lisp_Keymap, default_binding)},
310         {XD_LISP_OBJECT, offsetof(Lisp_Keymap, sub_maps_cache)},
311         {XD_LISP_OBJECT, offsetof(Lisp_Keymap, name)},
312         {XD_END}
313 };
314
315 /* No need for keymap_equal #### Why not? */
316 DEFINE_LRECORD_IMPLEMENTATION("keymap", keymap,
317                               mark_keymap, print_keymap, 0, 0, 0,
318                               keymap_description, Lisp_Keymap);
319 \f
320 /************************************************************************/
321 /*                Traversing keymaps and their parents                  */
322 /************************************************************************/
323
324 static Lisp_Object
325 traverse_keymaps(Lisp_Object start_keymap, Lisp_Object start_parents,
326                  Lisp_Object(*mapper)(Lisp_Object keymap, void*),
327                  void *mapper_arg)
328 {
329         /* This function can GC */
330         Lisp_Object keymap;
331         Lisp_Object tail = start_parents;
332         Lisp_Object malloc_sucks[10] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
333         Lisp_Object malloc_bites = Qnil;
334         int stack_depth = 0;
335         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
336         GCPRO3n(malloc_bites, start_keymap, tail,
337                 malloc_sucks, countof(malloc_sucks));
338
339         start_keymap = get_keymap(start_keymap, 1, 1);
340         keymap = start_keymap;
341         /* Hack special-case parents at top-level */
342         tail = !NILP(tail) ? tail : XKEYMAP(keymap)->parents;
343
344         for (;;) {
345                 Lisp_Object result;
346
347                 QUIT;
348                 result = mapper(keymap, mapper_arg);
349                 if (!NILP(result)) {
350                         while (CONSP(malloc_bites)) {
351                                 Lisp_Cons *victim = XCONS(malloc_bites);
352                                 malloc_bites = victim->cdr;
353                                 free_cons(victim);
354                         }
355                         UNGCPRO;
356                         return result;
357                 }
358                 if (NILP(tail)) {
359                         if (stack_depth == 0) {
360                                 UNGCPRO;
361                                 return Qnil;    /* Nothing found */
362                         }
363                         stack_depth--;
364                         if (CONSP(malloc_bites)) {
365                                 Lisp_Cons *victim = XCONS(malloc_bites);
366                                 tail = victim->car;
367                                 malloc_bites = victim->cdr;
368                                 free_cons(victim);
369                         } else {
370                                 tail = malloc_sucks[stack_depth];
371                         }
372                         keymap = XCAR(tail);
373                         tail = XCDR(tail);
374                 } else {
375                         Lisp_Object parents;
376
377                         keymap = XCAR(tail);
378                         tail = XCDR(tail);
379                         parents = XKEYMAP(keymap)->parents;
380                         if (!CONSP(parents)) ;
381                         else if (NILP(tail))
382                                 /* Tail-recurse */
383                                 tail = parents;
384                         else {
385                                 if (CONSP(malloc_bites))
386                                         malloc_bites =
387                                             noseeum_cons(tail, malloc_bites);
388                                 else if (stack_depth < countof(malloc_sucks)) {
389                                         malloc_sucks[stack_depth++] = tail;
390                                 } else {
391                                         /* *&@##[*&^$ C. @#[$*&@# Unix.
392                                          * Losers all. */
393                                         int i;
394                                         for (i = 0, malloc_bites = Qnil;
395                                              i < countof(malloc_sucks); i++) {
396                                                 malloc_bites =
397                                                     noseeum_cons(malloc_sucks
398                                                                  [i],
399                                                                  malloc_bites);
400                                         }
401                                 }
402                                 tail = parents;
403                         }
404                 }
405                 keymap = get_keymap(keymap, 1, 1);
406                 if (EQ(keymap, start_keymap)) {
407                         signal_simple_error("Cyclic keymap indirection",
408                                             start_keymap);
409                 }
410         }
411 }
412 \f
413 /************************************************************************/
414 /*                     Some low-level functions                         */
415 /************************************************************************/
416
417 static int bucky_sym_to_bucky_bit(Lisp_Object sym)
418 {
419         if (EQ(sym, Qcontrol))
420                 return XEMACS_MOD_CONTROL;
421         if (EQ(sym, Qmeta))
422                 return XEMACS_MOD_META;
423         if (EQ(sym, Qsuper))
424                 return XEMACS_MOD_SUPER;
425         if (EQ(sym, Qhyper))
426                 return XEMACS_MOD_HYPER;
427         if (EQ(sym, Qalt))
428                 return XEMACS_MOD_ALT;
429         if (EQ(sym, Qsymbol))
430                 return XEMACS_MOD_ALT;  /* #### - reverse compat */
431         if (EQ(sym, Qshift))
432                 return XEMACS_MOD_SHIFT;
433
434         return 0;
435 }
436
437 static Lisp_Object control_meta_superify(Lisp_Object frob, int modifiers)
438 {
439         if (modifiers == 0)
440                 return frob;
441         frob = Fcons(frob, Qnil);
442         if (modifiers & XEMACS_MOD_SHIFT)
443                 frob = Fcons(Qshift, frob);
444         if (modifiers & XEMACS_MOD_ALT)
445                 frob = Fcons(Qalt, frob);
446         if (modifiers & XEMACS_MOD_HYPER)
447                 frob = Fcons(Qhyper, frob);
448         if (modifiers & XEMACS_MOD_SUPER)
449                 frob = Fcons(Qsuper, frob);
450         if (modifiers & XEMACS_MOD_CONTROL)
451                 frob = Fcons(Qcontrol, frob);
452         if (modifiers & XEMACS_MOD_META)
453                 frob = Fcons(Qmeta, frob);
454         return frob;
455 }
456
457 static Lisp_Object
458 make_key_description(const struct key_data *key, int prettify)
459 {
460         Lisp_Object keysym = key->keysym;
461         int modifiers = key->modifiers;
462
463         if (prettify && CHARP(keysym)) {
464                 /* This is a little slow, but (control a) is prettier than (control 65).
465                    It's now ok to do this for digit-chars too, since we've fixed the
466                    bug where \9 read as the integer 9 instead of as the symbol with
467                    "9" as its name.
468                  */
469                 /* !!#### I'm not sure how correct this is. */
470                 Bufbyte str[1 + MAX_EMCHAR_LEN];
471                 Bytecount count = set_charptr_emchar(str, XCHAR(keysym));
472                 str[count] = 0;
473                 keysym = intern((char *)str);
474         }
475         return control_meta_superify(keysym, modifiers);
476 }
477 \f
478 /************************************************************************/
479 /*                   Low-level keymap-store functions                   */
480 /************************************************************************/
481
482 static Lisp_Object
483 raw_lookup_key(Lisp_Object keymap,
484                const struct key_data *raw_keys, int raw_keys_count,
485                int keys_so_far, int accept_default);
486
487 /* Relies on caller to gc-protect args */
488 static Lisp_Object
489 keymap_lookup_directly(Lisp_Object keymap, Lisp_Object keysym, int modifiers)
490 {
491         Lisp_Keymap *k;
492
493         modifiers &=
494             ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3 |
495               XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5 | XEMACS_MOD_BUTTON6 |
496               XEMACS_MOD_BUTTON7 | XEMACS_MOD_BUTTON8 | XEMACS_MOD_BUTTON9 |
497               XEMACS_MOD_BUTTON10 | XEMACS_MOD_BUTTON11 | XEMACS_MOD_BUTTON12 |
498               XEMACS_MOD_BUTTON13 | XEMACS_MOD_BUTTON14 | XEMACS_MOD_BUTTON15 |
499               XEMACS_MOD_BUTTON16 | XEMACS_MOD_BUTTON17 | XEMACS_MOD_BUTTON18 |
500               XEMACS_MOD_BUTTON19 | XEMACS_MOD_BUTTON20 | XEMACS_MOD_BUTTON21 |
501               XEMACS_MOD_BUTTON22 | XEMACS_MOD_BUTTON23 | XEMACS_MOD_BUTTON24 |
502               XEMACS_MOD_BUTTON25 | XEMACS_MOD_BUTTON26);
503         if ((modifiers &
504              ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER |
505                XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT))
506             != 0)
507                 abort();
508
509         k = XKEYMAP(keymap);
510
511         /* If the keysym is a one-character symbol, use the char code instead. */
512         if (SYMBOLP(keysym) && string_char_length(XSYMBOL(keysym)->name) == 1) {
513                 Lisp_Object i_fart_on_gcc =
514                     make_char(string_char(XSYMBOL(keysym)->name, 0));
515                 keysym = i_fart_on_gcc;
516         }
517
518         if (modifiers & XEMACS_MOD_META) {      /* Utterly hateful ESC lossage */
519                 Lisp_Object submap =
520                     Fgethash(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
521                              k->table, Qnil);
522                 if (NILP(submap))
523                         return Qnil;
524                 k = XKEYMAP(submap);
525                 modifiers &= ~XEMACS_MOD_META;
526         }
527
528         if (modifiers != 0) {
529                 Lisp_Object submap = Fgethash(MAKE_MODIFIER_HASH_KEY(modifiers),
530                                               k->table, Qnil);
531                 if (NILP(submap))
532                         return Qnil;
533                 k = XKEYMAP(submap);
534         }
535         return Fgethash(keysym, k->table, Qnil);
536 }
537
538 static void
539 keymap_store_inverse_internal(Lisp_Object inverse_table,
540                               Lisp_Object keysym, Lisp_Object value)
541 {
542         Lisp_Object keys = Fgethash(value, inverse_table, Qunbound);
543
544         if (UNBOUNDP(keys)) {
545                 keys = keysym;
546                 /* Don't cons this unless necessary */
547                 /* keys = Fcons (keysym, Qnil); */
548                 Fputhash(value, keys, inverse_table);
549         } else if (!CONSP(keys)) {
550                 /* Now it's necessary to cons */
551                 keys = Fcons(keys, keysym);
552                 Fputhash(value, keys, inverse_table);
553         } else {
554                 while (CONSP(XCDR(keys)))
555                         keys = XCDR(keys);
556                 XCDR(keys) = Fcons(XCDR(keys), keysym);
557                 /* No need to call puthash because we've destructively
558                    modified the list tail in place */
559         }
560 }
561
562 static void
563 keymap_delete_inverse_internal(Lisp_Object inverse_table,
564                                Lisp_Object keysym, Lisp_Object value)
565 {
566         Lisp_Object keys = Fgethash(value, inverse_table, Qunbound);
567         Lisp_Object new_keys = keys;
568         Lisp_Object tail;
569         Lisp_Object *prev;
570
571         if (UNBOUNDP(keys))
572                 abort();
573
574         for (prev = &new_keys, tail = new_keys;;
575              prev = &(XCDR(tail)), tail = XCDR(tail)) {
576                 if (EQ(tail, keysym)) {
577                         *prev = Qnil;
578                         break;
579                 } else if (EQ(keysym, XCAR(tail))) {
580                         *prev = XCDR(tail);
581                         break;
582                 }
583         }
584
585         if (NILP(new_keys))
586                 Fremhash(value, inverse_table);
587         else if (!EQ(keys, new_keys))
588                 /* Removed the first elt */
589                 Fputhash(value, new_keys, inverse_table);
590         /* else the list's tail has been modified, so we don't need to
591            touch the hash table again (the pointer in there is ok).
592          */
593 }
594
595 /* Prevent luser from shooting herself in the foot using something like
596    (define-key ctl-x-4-map "p" global-map) */
597 static void
598 check_keymap_definition_loop(Lisp_Object def, Lisp_Keymap * to_keymap)
599 {
600         def = get_keymap(def, 0, 0);
601
602         if (KEYMAPP(def)) {
603                 Lisp_Object maps;
604
605                 if (XKEYMAP(def) == to_keymap)
606                         signal_simple_error("Cyclic keymap definition", def);
607
608                 for (maps = keymap_submaps(def); CONSP(maps); maps = XCDR(maps))
609                         check_keymap_definition_loop(XCDR(XCAR(maps)),
610                                                      to_keymap);
611         }
612 }
613
614 static void
615 keymap_store_internal(Lisp_Object keysym, Lisp_Keymap * keymap, Lisp_Object def)
616 {
617         Lisp_Object prev_def = Fgethash(keysym, keymap->table, Qnil);
618
619         if (EQ(prev_def, def))
620                 return;
621
622         check_keymap_definition_loop(def, keymap);
623
624         if (!NILP(prev_def))
625                 keymap_delete_inverse_internal(keymap->inverse_table,
626                                                keysym, prev_def);
627         if (NILP(def)) {
628                 Fremhash(keysym, keymap->table);
629         } else {
630                 Fputhash(keysym, def, keymap->table);
631                 keymap_store_inverse_internal(keymap->inverse_table,
632                                               keysym, def);
633         }
634         keymap_tick++;
635 }
636
637 static Lisp_Object
638 create_bucky_submap(Lisp_Keymap * k, int modifiers,
639                     Lisp_Object parent_for_debugging_info)
640 {
641         Lisp_Object submap = Fmake_sparse_keymap(Qnil);
642         /* User won't see this, but it is nice for debugging Emacs */
643         XKEYMAP(submap)->name
644             = control_meta_superify(parent_for_debugging_info, modifiers);
645         /* Invalidate cache */
646         k->sub_maps_cache = Qt;
647         keymap_store_internal(MAKE_MODIFIER_HASH_KEY(modifiers), k, submap);
648         return submap;
649 }
650
651 /* Relies on caller to gc-protect keymap, keysym, value */
652 static void
653 keymap_store(Lisp_Object keymap, const struct key_data *key, Lisp_Object value)
654 {
655         Lisp_Object keysym = key->keysym;
656         int modifiers = key->modifiers;
657         Lisp_Keymap *k = XKEYMAP(keymap);
658
659         modifiers &=
660             ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3 |
661               XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5 | XEMACS_MOD_BUTTON6 |
662               XEMACS_MOD_BUTTON7 | XEMACS_MOD_BUTTON8 | XEMACS_MOD_BUTTON9 |
663               XEMACS_MOD_BUTTON10 | XEMACS_MOD_BUTTON11 | XEMACS_MOD_BUTTON12 |
664               XEMACS_MOD_BUTTON13 | XEMACS_MOD_BUTTON14 | XEMACS_MOD_BUTTON15 |
665               XEMACS_MOD_BUTTON16 | XEMACS_MOD_BUTTON17 | XEMACS_MOD_BUTTON18 |
666               XEMACS_MOD_BUTTON19 | XEMACS_MOD_BUTTON20 | XEMACS_MOD_BUTTON21 |
667               XEMACS_MOD_BUTTON22 | XEMACS_MOD_BUTTON23 | XEMACS_MOD_BUTTON24 |
668               XEMACS_MOD_BUTTON25 | XEMACS_MOD_BUTTON26);
669         assert((modifiers &
670                 ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER |
671                   XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0);
672
673         /* If the keysym is a one-character symbol, use the char code instead. */
674         if (SYMBOLP(keysym) && string_char_length(XSYMBOL(keysym)->name) == 1)
675                 keysym = make_char(string_char(XSYMBOL(keysym)->name, 0));
676
677         if (modifiers & XEMACS_MOD_META) {      /* Utterly hateful ESC lossage */
678                 Lisp_Object submap =
679                     Fgethash(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
680                              k->table, Qnil);
681                 if (NILP(submap))
682                         submap =
683                             create_bucky_submap(k, XEMACS_MOD_META, keymap);
684                 k = XKEYMAP(submap);
685                 modifiers &= ~XEMACS_MOD_META;
686         }
687
688         if (modifiers != 0) {
689                 Lisp_Object submap = Fgethash(MAKE_MODIFIER_HASH_KEY(modifiers),
690                                               k->table, Qnil);
691                 if (NILP(submap))
692                         submap = create_bucky_submap(k, modifiers, keymap);
693                 k = XKEYMAP(submap);
694         }
695         k->sub_maps_cache = Qt; /* Invalidate cache */
696         keymap_store_internal(keysym, k, value);
697 }
698 \f
699 /************************************************************************/
700 /*                   Listing the submaps of a keymap                    */
701 /************************************************************************/
702
703 struct keymap_submaps_closure {
704         Lisp_Object *result_locative;
705 };
706
707 static int
708 keymap_submaps_mapper_0(Lisp_Object key, Lisp_Object value,
709                         void *keymap_submaps_closure)
710 {
711         /* This function can GC */
712         /* Perform any autoloads, etc */
713         Fkeymapp(value);
714         return 0;
715 }
716
717 static int
718 keymap_submaps_mapper(Lisp_Object key, Lisp_Object value,
719                       void *keymap_submaps_closure)
720 {
721         /* This function can GC */
722         Lisp_Object *result_locative;
723         struct keymap_submaps_closure *cl =
724             (struct keymap_submaps_closure *)keymap_submaps_closure;
725         result_locative = cl->result_locative;
726
727         if (!NILP(Fkeymapp(value)))
728                 *result_locative = Fcons(Fcons(key, value), *result_locative);
729         return 0;
730 }
731
732 static int map_keymap_sort_predicate(Lisp_Object obj1, Lisp_Object obj2,
733                                      Lisp_Object pred);
734
735 static Lisp_Object keymap_submaps(Lisp_Object keymap)
736 {
737         /* This function can GC */
738         Lisp_Keymap *k = XKEYMAP(keymap);
739
740         if (EQ(k->sub_maps_cache, Qt)) {        /* Unknown */
741                 Lisp_Object result = Qnil;
742                 struct gcpro gcpro1, gcpro2;
743                 struct keymap_submaps_closure keymap_submaps_closure;
744
745                 GCPRO2(keymap, result);
746                 keymap_submaps_closure.result_locative = &result;
747                 /* Do this first pass to touch (and load) any autoloaded maps */
748                 elisp_maphash(keymap_submaps_mapper_0, k->table,
749                               &keymap_submaps_closure);
750                 result = Qnil;
751                 elisp_maphash(keymap_submaps_mapper, k->table,
752                               &keymap_submaps_closure);
753                 /* keep it sorted so that the result of accessible-keymaps is ordered */
754                 k->sub_maps_cache = list_sort(result,
755                                               Qnil, map_keymap_sort_predicate);
756                 UNGCPRO;
757         }
758         return k->sub_maps_cache;
759 }
760 \f
761 /************************************************************************/
762 /*                    Basic operations on keymaps                       */
763 /************************************************************************/
764
765 static Lisp_Object make_keymap(size_t size)
766 {
767         Lisp_Object result;
768         Lisp_Keymap *keymap = alloc_lcrecord_type(Lisp_Keymap, &lrecord_keymap);
769
770         XSETKEYMAP(result, keymap);
771
772         keymap->parents = Qnil;
773         keymap->prompt = Qnil;
774         keymap->table = Qnil;
775         keymap->inverse_table = Qnil;
776         keymap->default_binding = Qnil;
777         keymap->sub_maps_cache = Qnil;  /* No possible submaps */
778         keymap->name = Qnil;
779
780         if (size != 0) {        /* hack for copy-keymap */
781                 keymap->table =
782                     make_lisp_hash_table(size, HASH_TABLE_NON_WEAK,
783                                          HASH_TABLE_EQ);
784                 /* Inverse table is often less dense because of duplicate key-bindings.
785                    If not, it will grow anyway. */
786                 keymap->inverse_table =
787                     make_lisp_hash_table(size * 3 / 4, HASH_TABLE_NON_WEAK,
788                                          HASH_TABLE_EQ);
789         }
790         return result;
791 }
792
793 DEFUN("make-keymap", Fmake_keymap, 0, 1, 0,     /*
794 Construct and return a new keymap object.
795 All entries in it are nil, meaning "command undefined".
796
797 Optional argument NAME specifies a name to assign to the keymap,
798 as in `set-keymap-name'.  This name is only a debugging convenience;
799 it is not used except when printing the keymap.
800 */
801       (name))
802 {
803         Lisp_Object keymap = make_keymap(60);
804         if (!NILP(name))
805                 Fset_keymap_name(keymap, name);
806         return keymap;
807 }
808
809 DEFUN("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0,       /*
810 Construct and return a new keymap object.
811 All entries in it are nil, meaning "command undefined".  The only
812 difference between this function and `make-keymap' is that this function
813 returns a "smaller" keymap (one that is expected to contain fewer
814 entries).  As keymaps dynamically resize, this distinction is not great.
815
816 Optional argument NAME specifies a name to assign to the keymap,
817 as in `set-keymap-name'.  This name is only a debugging convenience;
818 it is not used except when printing the keymap.
819 */
820       (name))
821 {
822         Lisp_Object keymap = make_keymap(8);
823         if (!NILP(name))
824                 Fset_keymap_name(keymap, name);
825         return keymap;
826 }
827
828 DEFUN("keymap-parents", Fkeymap_parents, 1, 1, 0,       /*
829 Return the `parent' keymaps of KEYMAP, or nil.
830 The parents of a keymap are searched for keybindings when a key sequence
831 isn't bound in this one.  `(current-global-map)' is the default parent
832 of all keymaps.
833 */
834       (keymap))
835 {
836         keymap = get_keymap(keymap, 1, 1);
837         return Fcopy_sequence(XKEYMAP(keymap)->parents);
838 }
839
840 static Lisp_Object
841 traverse_keymaps_noop(Lisp_Object UNUSED(keymap), void *UNUSED(arg))
842 {
843         return Qnil;
844 }
845
846 DEFUN("set-keymap-parents", Fset_keymap_parents, 2, 2, 0,       /*
847 Set the `parent' keymaps of KEYMAP to PARENTS.
848 The parents of a keymap are searched for keybindings when a key sequence
849 isn't bound in this one.  `(current-global-map)' is the default parent
850 of all keymaps.
851 */
852       (keymap, parents))
853 {
854         /* This function can GC */
855         Lisp_Object k;
856         struct gcpro gcpro1, gcpro2;
857
858         GCPRO2(keymap, parents);
859         keymap = get_keymap(keymap, 1, 1);
860
861         if (KEYMAPP(parents))   /* backwards-compatibility */
862                 parents = list1(parents);
863         if (!NILP(parents)) {
864                 Lisp_Object tail = parents;
865                 while (!NILP(tail)) {
866                         QUIT;
867                         CHECK_CONS(tail);
868                         k = XCAR(tail);
869                         /* Require that it be an actual keymap object, rather than a symbol
870                            with a (crockish) symbol-function which is a keymap */
871                         CHECK_KEYMAP(k);        /* get_keymap (k, 1, 1); */
872                         tail = XCDR(tail);
873                 }
874         }
875
876         /* Check for circularities */
877         traverse_keymaps(keymap, parents, traverse_keymaps_noop, 0);
878         keymap_tick++;
879         XKEYMAP(keymap)->parents = Fcopy_sequence(parents);
880         UNGCPRO;
881         return parents;
882 }
883
884 DEFUN("set-keymap-name", Fset_keymap_name, 2, 2, 0,     /*
885 Set the `name' of the KEYMAP to NEW-NAME.
886 The name is only a debugging convenience; it is not used except
887 when printing the keymap.
888 */
889       (keymap, new_name))
890 {
891         keymap = get_keymap(keymap, 1, 1);
892
893         XKEYMAP(keymap)->name = new_name;
894         return new_name;
895 }
896
897 DEFUN("keymap-name", Fkeymap_name, 1, 1, 0,     /*
898 Return the `name' of KEYMAP.
899 The name is only a debugging convenience; it is not used except
900 when printing the keymap.
901 */
902       (keymap))
903 {
904         keymap = get_keymap(keymap, 1, 1);
905
906         return XKEYMAP(keymap)->name;
907 }
908
909 DEFUN("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
910 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
911 if no prompt is desired.  The prompt is shown in the echo-area
912 when reading a key-sequence to be looked-up in this keymap.
913 */
914       (keymap, new_prompt))
915 {
916         keymap = get_keymap(keymap, 1, 1);
917
918         if (!NILP(new_prompt))
919                 CHECK_STRING(new_prompt);
920
921         XKEYMAP(keymap)->prompt = new_prompt;
922         return new_prompt;
923 }
924
925 static Lisp_Object
926 keymap_prompt_mapper(Lisp_Object keymap, void *UNUSED(arg))
927 {
928         return XKEYMAP(keymap)->prompt;
929 }
930
931 DEFUN("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
932 Return the `prompt' of KEYMAP.
933 If non-nil, the prompt is shown in the echo-area
934 when reading a key-sequence to be looked-up in this keymap.
935 */
936       (keymap, use_inherited))
937 {
938         /* This function can GC */
939         Lisp_Object prompt;
940
941         keymap = get_keymap(keymap, 1, 1);
942         prompt = XKEYMAP(keymap)->prompt;
943         if (!NILP(prompt) || NILP(use_inherited)) {
944                 return prompt;
945         } else {
946                 return traverse_keymaps(keymap, Qnil, keymap_prompt_mapper, 0);
947         }
948 }
949
950 DEFUN("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
951 Sets the default binding of KEYMAP to COMMAND, or `nil'
952 if no default is desired.  The default-binding is returned when
953 no other binding for a key-sequence is found in the keymap.
954 If a keymap has a non-nil default-binding, neither the keymap's
955 parents nor the current global map are searched for key bindings.
956 */
957       (keymap, command))
958 {
959         /* This function can GC */
960         keymap = get_keymap(keymap, 1, 1);
961
962         XKEYMAP(keymap)->default_binding = command;
963         return command;
964 }
965
966 DEFUN("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0,       /*
967 Return the default binding of KEYMAP, or `nil' if it has none.
968 The default-binding is returned when no other binding for a key-sequence
969 is found in the keymap.
970 If a keymap has a non-nil default-binding, neither the keymap's
971 parents nor the current global map are searched for key bindings.
972 */
973       (keymap))
974 {
975         /* This function can GC */
976         keymap = get_keymap(keymap, 1, 1);
977         return XKEYMAP(keymap)->default_binding;
978 }
979
980 DEFUN("keymapp", Fkeymapp, 1, 1, 0,     /*
981 Return t if OBJECT is a keymap object.
982 The keymap may be autoloaded first if necessary.
983 */
984       (object))
985 {
986         /* This function can GC */
987         Lisp_Object tmp = get_keymap(object, 0, 0);
988         return KEYMAPP(tmp) ? Qt : Qnil;
989 }
990
991 /* Check that OBJECT is a keymap (after dereferencing through any
992    symbols).  If it is, return it.
993
994    If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
995    is an autoload form, do the autoload and try again.
996    If AUTOLOAD is nonzero, callers must assume GC is possible.
997
998    ERRORP controls how we respond if OBJECT isn't a keymap.
999    If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
1000
1001    Note that most of the time, we don't want to pursue autoloads.
1002    Functions like Faccessible_keymaps which scan entire keymap trees
1003    shouldn't load every autoloaded keymap.  I'm not sure about this,
1004    but it seems to me that only read_key_sequence, Flookup_key, and
1005    Fdefine_key should cause keymaps to be autoloaded.  */
1006
1007 Lisp_Object get_keymap(Lisp_Object object, int errorp, int autoload)
1008 {
1009         /* This function can GC */
1010         while (1) {
1011                 Lisp_Object tem = indirect_function(object, 0);
1012
1013                 if (KEYMAPP(tem))
1014                         return tem;
1015                 /* Should we do an autoload?  */
1016                 else if (autoload
1017                          /* (autoload "filename" doc nil keymap) */
1018                          && SYMBOLP(object)
1019                          && CONSP(tem)
1020                          && EQ(XCAR(tem), Qautoload)
1021                          && EQ(Fcar(Fcdr(Fcdr(Fcdr(Fcdr(tem))))), Qkeymap)) {
1022                         /* do_autoload GCPROs both arguments */
1023                         do_autoload(tem, object);
1024                 } else if (errorp)
1025                         object = wrong_type_argument(Qkeymapp, object);
1026                 else
1027                         return Qnil;
1028         }
1029 }
1030
1031 /* Given OBJECT which was found in a slot in a keymap,
1032    trace indirect definitions to get the actual definition of that slot.
1033    An indirect definition is a list of the form
1034    (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1035    and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1036  */
1037 static Lisp_Object get_keyelt(Lisp_Object object, int accept_default)
1038 {
1039         /* This function can GC */
1040         Lisp_Object map;
1041
1042       tail_recurse:
1043         if (!CONSP(object))
1044                 return object;
1045
1046         {
1047                 struct gcpro gcpro1;
1048                 GCPRO1(object);
1049                 map = XCAR(object);
1050                 map = get_keymap(map, 0, 1);
1051                 UNGCPRO;
1052         }
1053         /* If the contents are (KEYMAP . ELEMENT), go indirect.  */
1054         if (!NILP(map)) {
1055                 Lisp_Object idx = Fcdr(object);
1056                 struct key_data indirection;
1057                 if (CHARP(idx)) {
1058                         Lisp_Event event;
1059                         event.event_type = empty_event;
1060                         character_to_event(XCHAR(idx), &event,
1061                                            XCONSOLE(Vselected_console), 0, 0);
1062                         indirection = event.event.key;
1063                 } else if (CONSP(idx)) {
1064                         if (!INTP(XCDR(idx)))
1065                                 return Qnil;
1066                         indirection.keysym = XCAR(idx);
1067                         indirection.modifiers = (unsigned char)XINT(XCDR(idx));
1068                 } else if (SYMBOLP(idx)) {
1069                         indirection.keysym = idx;
1070                         indirection.modifiers = 0;
1071                 } else {
1072                         /* Random junk */
1073                         return Qnil;
1074                 }
1075                 return raw_lookup_key(map, &indirection, 1, 0, accept_default);
1076         } else if (STRINGP(XCAR(object))) {
1077                 /* If the keymap contents looks like (STRING . DEFN),
1078                    use DEFN.
1079                    Keymap alist elements like (CHAR MENUSTRING . DEFN)
1080                    will be used by HierarKey menus.  */
1081                 object = XCDR(object);
1082                 goto tail_recurse;
1083         } else {
1084                 /* Anything else is really the value.  */
1085                 return object;
1086         }
1087 }
1088
1089 static Lisp_Object
1090 keymap_lookup_1(Lisp_Object keymap, const struct key_data *key,
1091                 int accept_default)
1092 {
1093         /* This function can GC */
1094         return get_keyelt(keymap_lookup_directly(keymap,
1095                                                  key->keysym, key->modifiers),
1096                           accept_default);
1097 }
1098 \f
1099 /************************************************************************/
1100 /*                          Copying keymaps                             */
1101 /************************************************************************/
1102
1103 struct copy_keymap_inverse_closure {
1104         Lisp_Object inverse_table;
1105 };
1106
1107 static int
1108 copy_keymap_inverse_mapper(Lisp_Object key, Lisp_Object value,
1109                            void *copy_keymap_inverse_closure)
1110 {
1111         struct copy_keymap_inverse_closure *closure =
1112             (struct copy_keymap_inverse_closure *)copy_keymap_inverse_closure;
1113
1114         /* copy-sequence deals with dotted lists. */
1115         if (CONSP(value))
1116                 value = Fcopy_list(value);
1117         Fputhash(key, value, closure->inverse_table);
1118
1119         return 0;
1120 }
1121
1122 static Lisp_Object copy_keymap_internal(Lisp_Keymap * keymap)
1123 {
1124         Lisp_Object nkm = make_keymap(0);
1125         Lisp_Keymap *new_keymap = XKEYMAP(nkm);
1126         struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1127         copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1128
1129         new_keymap->parents = Fcopy_sequence(keymap->parents);
1130         new_keymap->sub_maps_cache = Qnil;      /* No submaps */
1131         new_keymap->table = Fcopy_hash_table(keymap->table);
1132         new_keymap->inverse_table = Fcopy_hash_table(keymap->inverse_table);
1133         new_keymap->default_binding = keymap->default_binding;
1134         /* After copying the inverse map, we need to copy the conses which
1135            are its values, lest they be shared by the copy, and mangled.
1136          */
1137         elisp_maphash(copy_keymap_inverse_mapper, keymap->inverse_table,
1138                       &copy_keymap_inverse_closure);
1139         return nkm;
1140 }
1141
1142 static Lisp_Object copy_keymap(Lisp_Object keymap);
1143
1144 struct copy_keymap_closure {
1145         Lisp_Keymap *self;
1146 };
1147
1148 static int
1149 copy_keymap_mapper(Lisp_Object key, Lisp_Object value,
1150                    void *copy_keymap_closure)
1151 {
1152         /* This function can GC */
1153         struct copy_keymap_closure *closure =
1154             (struct copy_keymap_closure *)copy_keymap_closure;
1155
1156         /* When we encounter a keymap which is indirected through a
1157            symbol, we need to copy the sub-map.  In v18, the form
1158            (lookup-key (copy-keymap global-map) "\C-x")
1159            returned a new keymap, not the symbol 'Control-X-prefix.
1160          */
1161         value = get_keymap(value, 0, 1);        /* #### autoload GC-safe here? */
1162         if (KEYMAPP(value))
1163                 keymap_store_internal(key, closure->self, copy_keymap(value));
1164         return 0;
1165 }
1166
1167 static Lisp_Object copy_keymap(Lisp_Object keymap)
1168 {
1169         /* This function can GC */
1170         struct copy_keymap_closure copy_keymap_closure;
1171
1172         keymap = copy_keymap_internal(XKEYMAP(keymap));
1173         copy_keymap_closure.self = XKEYMAP(keymap);
1174         elisp_maphash(copy_keymap_mapper,
1175                       XKEYMAP(keymap)->table, &copy_keymap_closure);
1176         return keymap;
1177 }
1178
1179 DEFUN("copy-keymap", Fcopy_keymap, 1, 1, 0,     /*
1180 Return a copy of the keymap KEYMAP.
1181 The copy starts out with the same definitions of KEYMAP,
1182 but changing either the copy or KEYMAP does not affect the other.
1183 Any key definitions that are subkeymaps are recursively copied.
1184 */
1185       (keymap))
1186 {
1187         /* This function can GC */
1188         keymap = get_keymap(keymap, 1, 1);
1189         return copy_keymap(keymap);
1190 }
1191 \f
1192 static int keymap_fullness(Lisp_Object keymap)
1193 {
1194         /* This function can GC */
1195         int fullness;
1196         Lisp_Object sub_maps;
1197         struct gcpro gcpro1, gcpro2;
1198
1199         keymap = get_keymap(keymap, 1, 1);
1200         fullness = XINT(Fhash_table_count(XKEYMAP(keymap)->table));
1201         GCPRO2(keymap, sub_maps);
1202         for (sub_maps = keymap_submaps(keymap);
1203              !NILP(sub_maps); sub_maps = XCDR(sub_maps)) {
1204                 if (MODIFIER_HASH_KEY_BITS(XCAR(XCAR(sub_maps))) != 0) {
1205                         Lisp_Object bucky_map = XCDR(XCAR(sub_maps));
1206                         fullness--;     /* don't count bucky maps themselves. */
1207                         fullness += keymap_fullness(bucky_map);
1208                 }
1209         }
1210         UNGCPRO;
1211         return fullness;
1212 }
1213
1214 DEFUN("keymap-fullness", Fkeymap_fullness, 1, 1, 0,     /*
1215 Return the number of bindings in the keymap.
1216 */
1217       (keymap))
1218 {
1219         /* This function can GC */
1220         return make_int(keymap_fullness(get_keymap(keymap, 1, 1)));
1221 }
1222 \f
1223 /************************************************************************/
1224 /*                        Defining keys in keymaps                      */
1225 /************************************************************************/
1226
1227 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1228    and perform any necessary canonicalization. */
1229
1230 static void
1231 define_key_check_and_coerce_keysym(Lisp_Object spec,
1232                                    Lisp_Object * keysym, int modifiers)
1233 {
1234         /* Now, check and massage the trailing keysym specifier. */
1235         if (SYMBOLP(*keysym)) {
1236                 if (string_char_length(XSYMBOL(*keysym)->name) == 1) {
1237                         Lisp_Object ream_gcc_up_the_ass =
1238                             make_char(string_char(XSYMBOL(*keysym)->name, 0));
1239                         *keysym = ream_gcc_up_the_ass;
1240                         goto fixnum_keysym;
1241                 }
1242         } else if (CHAR_OR_CHAR_INTP(*keysym)) {
1243                 CHECK_CHAR_COERCE_INT(*keysym);
1244               fixnum_keysym:
1245                 if (XCHAR(*keysym) < ' '
1246                     /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */ )
1247                         /* yuck!  Can't make the above restriction; too many compatibility
1248                            problems ... */
1249                         signal_simple_error("keysym char must be printable",
1250                                             *keysym);
1251                 /* #### This bites!  I want to be able to write (control shift a) */
1252                 if (modifiers & XEMACS_MOD_SHIFT)
1253                         signal_simple_error
1254                             ("The `shift' modifier may not be applied to ASCII keysyms",
1255                              spec);
1256         } else {
1257                 signal_simple_error("Unknown keysym specifier", *keysym);
1258         }
1259
1260         if (SYMBOLP(*keysym)) {
1261                 char *name = (char *)string_data(XSYMBOL(*keysym)->name);
1262
1263                 /* FSFmacs uses symbols with the printed representation of keysyms in
1264                    their names, like 'M-x, and we use the syntax '(meta x).  So, to avoid
1265                    confusion, notice the M-x syntax and signal an error - because
1266                    otherwise it would be interpreted as a regular keysym, and would even
1267                    show up in the list-buffers output, causing confusion to the naive.
1268
1269                    We can get away with this because none of the X keysym names contain
1270                    a hyphen (some contain underscore, however).
1271
1272                    It might be useful to reject keysyms which are not x-valid-keysym-
1273                    name-p, but that would interfere with various tricks we do to
1274                    sanitize the Sun keyboards, and would make it trickier to
1275                    conditionalize a .emacs file for multiple X servers.
1276                  */
1277                 if (((int)strlen(name) >= 2 && name[1] == '-')
1278 #if 1
1279                     ||
1280                     /* Ok, this is a bit more dubious - prevent people from doing things
1281                        like (global-set-key 'RET 'something) because that will have the
1282                        same problem as above.  (Gag!)  Maybe we should just silently
1283                        accept these as aliases for the "real" names?
1284                      */
1285                     (string_length(XSYMBOL(*keysym)->name) <= 3 &&
1286                      (!strcmp(name, "LFD") ||
1287                       !strcmp(name, "TAB") ||
1288                       !strcmp(name, "RET") ||
1289                       !strcmp(name, "ESC") ||
1290                       !strcmp(name, "DEL") ||
1291                       !strcmp(name, "SPC") || !strcmp(name, "BS")))
1292 #endif                          /* unused */
1293                     )
1294                         signal_simple_error
1295                             ("Invalid (FSF Emacs) key format (see doc of define-key)",
1296                              *keysym);
1297
1298                 /* #### Ok, this is a bit more dubious - make people not lose if they
1299                    do things like (global-set-key 'RET 'something) because that would
1300                    otherwise have the same problem as above.  (Gag!)  We silently
1301                    accept these as aliases for the "real" names.
1302                  */
1303                 else if (!strncmp(name, "kp_", 3)) {
1304                         /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1305                         char temp[50];
1306
1307                         strncpy(temp, name, sizeof(temp));
1308                         temp[sizeof(temp) - 1] = '\0';
1309                         temp[2] = '-';
1310                         *keysym = Fintern_soft(make_string((Bufbyte *) temp,
1311                                                            strlen(temp)), Qnil);
1312                 } else if (EQ(*keysym, QLFD))
1313                         *keysym = QKlinefeed;
1314                 else if (EQ(*keysym, QTAB))
1315                         *keysym = QKtab;
1316                 else if (EQ(*keysym, QRET))
1317                         *keysym = QKreturn;
1318                 else if (EQ(*keysym, QESC))
1319                         *keysym = QKescape;
1320                 else if (EQ(*keysym, QDEL))
1321                         *keysym = QKdelete;
1322                 else if (EQ(*keysym, QSPC))
1323                         *keysym = QKspace;
1324                 else if (EQ(*keysym, QBS))
1325                         *keysym = QKbackspace;
1326                 /* Emacs compatibility */
1327                 else if (EQ(*keysym, Qdown_mouse_1))
1328                         *keysym = Qbutton1;
1329                 else if (EQ(*keysym, Qdown_mouse_2))
1330                         *keysym = Qbutton2;
1331                 else if (EQ(*keysym, Qdown_mouse_3))
1332                         *keysym = Qbutton3;
1333                 else if (EQ(*keysym, Qdown_mouse_4))
1334                         *keysym = Qbutton4;
1335                 else if (EQ(*keysym, Qdown_mouse_5))
1336                         *keysym = Qbutton5;
1337                 else if (EQ(*keysym, Qdown_mouse_6))
1338                         *keysym = Qbutton6;
1339                 else if (EQ(*keysym, Qdown_mouse_7))
1340                         *keysym = Qbutton7;
1341                 else if (EQ(*keysym, Qdown_mouse_8))
1342                         *keysym = Qbutton8;
1343                 else if (EQ(*keysym, Qdown_mouse_9))
1344                         *keysym = Qbutton9;
1345                 else if (EQ(*keysym, Qdown_mouse_10))
1346                         *keysym = Qbutton10;
1347                 else if (EQ(*keysym, Qdown_mouse_11))
1348                         *keysym = Qbutton11;
1349                 else if (EQ(*keysym, Qdown_mouse_12))
1350                         *keysym = Qbutton12;
1351                 else if (EQ(*keysym, Qdown_mouse_13))
1352                         *keysym = Qbutton13;
1353                 else if (EQ(*keysym, Qdown_mouse_14))
1354                         *keysym = Qbutton14;
1355                 else if (EQ(*keysym, Qdown_mouse_15))
1356                         *keysym = Qbutton15;
1357                 else if (EQ(*keysym, Qdown_mouse_16))
1358                         *keysym = Qbutton16;
1359                 else if (EQ(*keysym, Qdown_mouse_17))
1360                         *keysym = Qbutton17;
1361                 else if (EQ(*keysym, Qdown_mouse_18))
1362                         *keysym = Qbutton18;
1363                 else if (EQ(*keysym, Qdown_mouse_19))
1364                         *keysym = Qbutton19;
1365                 else if (EQ(*keysym, Qdown_mouse_20))
1366                         *keysym = Qbutton20;
1367                 else if (EQ(*keysym, Qdown_mouse_21))
1368                         *keysym = Qbutton21;
1369                 else if (EQ(*keysym, Qdown_mouse_22))
1370                         *keysym = Qbutton22;
1371                 else if (EQ(*keysym, Qdown_mouse_23))
1372                         *keysym = Qbutton23;
1373                 else if (EQ(*keysym, Qdown_mouse_24))
1374                         *keysym = Qbutton24;
1375                 else if (EQ(*keysym, Qdown_mouse_25))
1376                         *keysym = Qbutton25;
1377                 else if (EQ(*keysym, Qdown_mouse_26))
1378                         *keysym = Qbutton26;
1379                 else if (EQ(*keysym, Qdown_mouse_27))
1380                         *keysym = Qbutton27;
1381                 else if (EQ(*keysym, Qdown_mouse_28))
1382                         *keysym = Qbutton28;
1383                 else if (EQ(*keysym, Qdown_mouse_29))
1384                         *keysym = Qbutton29;
1385                 else if (EQ(*keysym, Qdown_mouse_30))
1386                         *keysym = Qbutton30;
1387                 else if (EQ(*keysym, Qdown_mouse_31))
1388                         *keysym = Qbutton31;
1389                 else if (EQ(*keysym, Qdown_mouse_32))
1390                         *keysym = Qbutton32;
1391                 else if (EQ(*keysym, Qmouse_1))
1392                         *keysym = Qbutton1up;
1393                 else if (EQ(*keysym, Qmouse_2))
1394                         *keysym = Qbutton2up;
1395                 else if (EQ(*keysym, Qmouse_3))
1396                         *keysym = Qbutton3up;
1397                 else if (EQ(*keysym, Qmouse_4))
1398                         *keysym = Qbutton4up;
1399                 else if (EQ(*keysym, Qmouse_5))
1400                         *keysym = Qbutton5up;
1401                 else if (EQ(*keysym, Qmouse_6))
1402                         *keysym = Qbutton6up;
1403                 else if (EQ(*keysym, Qmouse_7))
1404                         *keysym = Qbutton7up;
1405                 else if (EQ(*keysym, Qmouse_8))
1406                         *keysym = Qbutton8up;
1407                 else if (EQ(*keysym, Qmouse_9))
1408                         *keysym = Qbutton9up;
1409                 else if (EQ(*keysym, Qmouse_10))
1410                         *keysym = Qbutton10up;
1411                 else if (EQ(*keysym, Qmouse_11))
1412                         *keysym = Qbutton11up;
1413                 else if (EQ(*keysym, Qmouse_12))
1414                         *keysym = Qbutton12up;
1415                 else if (EQ(*keysym, Qmouse_13))
1416                         *keysym = Qbutton13up;
1417                 else if (EQ(*keysym, Qmouse_14))
1418                         *keysym = Qbutton14up;
1419                 else if (EQ(*keysym, Qmouse_15))
1420                         *keysym = Qbutton15up;
1421                 else if (EQ(*keysym, Qmouse_16))
1422                         *keysym = Qbutton16up;
1423                 else if (EQ(*keysym, Qmouse_17))
1424                         *keysym = Qbutton17up;
1425                 else if (EQ(*keysym, Qmouse_18))
1426                         *keysym = Qbutton18up;
1427                 else if (EQ(*keysym, Qmouse_19))
1428                         *keysym = Qbutton19up;
1429                 else if (EQ(*keysym, Qmouse_20))
1430                         *keysym = Qbutton20up;
1431                 else if (EQ(*keysym, Qmouse_21))
1432                         *keysym = Qbutton21up;
1433                 else if (EQ(*keysym, Qmouse_22))
1434                         *keysym = Qbutton22up;
1435                 else if (EQ(*keysym, Qmouse_23))
1436                         *keysym = Qbutton23up;
1437                 else if (EQ(*keysym, Qmouse_24))
1438                         *keysym = Qbutton24up;
1439                 else if (EQ(*keysym, Qmouse_25))
1440                         *keysym = Qbutton25up;
1441                 else if (EQ(*keysym, Qmouse_26))
1442                         *keysym = Qbutton26up;
1443                 else if (EQ(*keysym, Qmouse_27))
1444                         *keysym = Qbutton27up;
1445                 else if (EQ(*keysym, Qmouse_28))
1446                         *keysym = Qbutton28up;
1447                 else if (EQ(*keysym, Qmouse_29))
1448                         *keysym = Qbutton29up;
1449                 else if (EQ(*keysym, Qmouse_30))
1450                         *keysym = Qbutton30up;
1451                 else if (EQ(*keysym, Qmouse_31))
1452                         *keysym = Qbutton31up;
1453                 else if (EQ(*keysym, Qmouse_32))
1454                         *keysym = Qbutton32up;
1455         }
1456 }
1457
1458 /* Given any kind of key-specifier, return a keysym and modifier mask.
1459    Proper canonicalization is performed:
1460
1461    -- integers are converted into the equivalent characters.
1462    -- one-character strings are converted into the equivalent characters.
1463  */
1464
1465 static void define_key_parser(Lisp_Object spec, struct key_data *returned_value)
1466 {
1467         if (CHAR_OR_CHAR_INTP(spec)) {
1468                 Lisp_Event event;
1469                 event.event_type = empty_event;
1470                 character_to_event(XCHAR_OR_CHAR_INT(spec), &event,
1471                                    XCONSOLE(Vselected_console), 0, 0);
1472                 returned_value->keysym = event.event.key.keysym;
1473                 returned_value->modifiers = event.event.key.modifiers;
1474         } else if (EVENTP(spec)) {
1475                 switch (XEVENT(spec)->event_type) {
1476                 case key_press_event: {
1477                         returned_value->keysym =
1478                                 XEVENT(spec)->event.key.keysym;
1479                         returned_value->modifiers =
1480                                 XEVENT(spec)->event.key.modifiers;
1481                         break;
1482                 }
1483                 case button_press_event:
1484                 case button_release_event: {
1485                         int down = (XEVENT(spec)->event_type ==
1486                                     button_press_event);
1487                         switch (XEVENT(spec)->event.button.button) {
1488                         case 1:
1489                                 returned_value->keysym =
1490                                         (down ? Qbutton1 : Qbutton1up);
1491                                 break;
1492                         case 2:
1493                                 returned_value->keysym =
1494                                         (down ? Qbutton2 : Qbutton2up);
1495                                 break;
1496                         case 3:
1497                                 returned_value->keysym =
1498                                         (down ? Qbutton3 : Qbutton3up);
1499                                 break;
1500                         case 4:
1501                                 returned_value->keysym =
1502                                         (down ? Qbutton4 : Qbutton4up);
1503                                 break;
1504                         case 5:
1505                                 returned_value->keysym =
1506                                         (down ? Qbutton5 : Qbutton5up);
1507                                 break;
1508                         case 6:
1509                                 returned_value->keysym =
1510                                         (down ? Qbutton6 : Qbutton6up);
1511                                 break;
1512                         case 7:
1513                                 returned_value->keysym =
1514                                         (down ? Qbutton7 : Qbutton7up);
1515                                 break;
1516                         case 8:
1517                                 returned_value->keysym =
1518                                         (down ? Qbutton8 : Qbutton8up);
1519                                 break;
1520                         case 9:
1521                                 returned_value->keysym =
1522                                         (down ? Qbutton9 : Qbutton9up);
1523                                 break;
1524                         case 10:
1525                                 returned_value->keysym =
1526                                         (down ? Qbutton10 : Qbutton10up);
1527                                 break;
1528                         case 11:
1529                                 returned_value->keysym =
1530                                         (down ? Qbutton11 : Qbutton11up);
1531                                 break;
1532                         case 12:
1533                                 returned_value->keysym =
1534                                         (down ? Qbutton12 : Qbutton12up);
1535                                 break;
1536                         case 13:
1537                                 returned_value->keysym =
1538                                         (down ? Qbutton13 : Qbutton13up);
1539                                 break;
1540                         case 14:
1541                                 returned_value->keysym =
1542                                         (down ? Qbutton14 : Qbutton14up);
1543                                 break;
1544                         case 15:
1545                                 returned_value->keysym =
1546                                         (down ? Qbutton15 : Qbutton15up);
1547                                 break;
1548                         case 16:
1549                                 returned_value->keysym =
1550                                         (down ? Qbutton16 : Qbutton16up);
1551                                 break;
1552                         case 17:
1553                                 returned_value->keysym =
1554                                         (down ? Qbutton17 : Qbutton17up);
1555                                 break;
1556                         case 18:
1557                                 returned_value->keysym =
1558                                         (down ? Qbutton18 : Qbutton18up);
1559                                 break;
1560                         case 19:
1561                                 returned_value->keysym =
1562                                         (down ? Qbutton19 : Qbutton19up);
1563                                 break;
1564                         case 20:
1565                                 returned_value->keysym =
1566                                         (down ? Qbutton20 : Qbutton20up);
1567                                 break;
1568                         case 21:
1569                                 returned_value->keysym =
1570                                         (down ? Qbutton21 : Qbutton21up);
1571                                 break;
1572                         case 22:
1573                                 returned_value->keysym =
1574                                         (down ? Qbutton22 : Qbutton22up);
1575                                 break;
1576                         case 23:
1577                                 returned_value->keysym =
1578                                         (down ? Qbutton23 : Qbutton23up);
1579                                 break;
1580                         case 24:
1581                                 returned_value->keysym =
1582                                         (down ? Qbutton24 : Qbutton24up);
1583                                 break;
1584                         case 25:
1585                                 returned_value->keysym =
1586                                         (down ? Qbutton25 : Qbutton25up);
1587                                 break;
1588                         case 26:
1589                                 returned_value->keysym =
1590                                         (down ? Qbutton26 : Qbutton26up);
1591                                 break;
1592                         case 27:
1593                                 returned_value->keysym =
1594                                         (down ? Qbutton27 : Qbutton27up);
1595                                 break;
1596                         case 28:
1597                                 returned_value->keysym =
1598                                         (down ? Qbutton28 : Qbutton28up);
1599                                 break;
1600                         case 29:
1601                                 returned_value->keysym =
1602                                         (down ? Qbutton29 : Qbutton29up);
1603                                 break;
1604                         case 30:
1605                                 returned_value->keysym =
1606                                         (down ? Qbutton30 : Qbutton30up);
1607                                 break;
1608                         case 31:
1609                                 returned_value->keysym =
1610                                         (down ? Qbutton31 : Qbutton31up);
1611                                 break;
1612                         case 32:
1613                                 returned_value->keysym =
1614                                         (down ? Qbutton32 : Qbutton32up);
1615                                 break;
1616                         default:
1617                                 returned_value->keysym =
1618                                         (down ? Qbutton0 : Qbutton0up);
1619                                 break;
1620                         }
1621                         returned_value->modifiers =
1622                                 XEVENT(spec)->event.button.modifiers;
1623                         break;
1624                 }
1625
1626                 case empty_event:
1627                 case pointer_motion_event:
1628                 case process_event:
1629                 case timeout_event:
1630                 case magic_event:
1631                 case magic_eval_event:
1632                 case eval_event:
1633                 case misc_user_event:
1634 #ifdef EF_USE_ASYNEQ
1635                 case eaten_myself_event:
1636                 case work_started_event:
1637                 case work_finished_event:
1638 #endif  /* EF_USE_ASYNEQ */
1639                 case dead_event:
1640                 default:
1641                         signal_error(Qwrong_type_argument,
1642                                      list2(build_translated_string(
1643                                                    "unable to bind this "
1644                                                    "type of event"), spec));
1645                 }
1646         } else if (SYMBOLP(spec)) {
1647                 /* Be nice, allow = to mean (=) */
1648                 if (bucky_sym_to_bucky_bit(spec) != 0)
1649                         signal_simple_error("Key is a modifier name", spec);
1650                 define_key_check_and_coerce_keysym(spec, &spec, 0);
1651                 returned_value->keysym = spec;
1652                 returned_value->modifiers = 0;
1653         } else if (CONSP(spec)) {
1654                 int modifiers = 0;
1655                 Lisp_Object keysym = Qnil;
1656                 Lisp_Object rest = spec;
1657
1658                 /* First, parse out the leading modifier symbols. */
1659                 while (CONSP(rest)) {
1660                         int modifier;
1661
1662                         keysym = XCAR(rest);
1663                         modifier = bucky_sym_to_bucky_bit(keysym);
1664                         modifiers |= modifier;
1665                         if (!NILP(XCDR(rest))) {
1666                                 if (!modifier)
1667                                         signal_simple_error("Unknown modifier",
1668                                                             keysym);
1669                         } else {
1670                                 if (modifier)
1671                                         signal_simple_error
1672                                             ("Nothing but modifiers here",
1673                                              spec);
1674                         }
1675                         rest = XCDR(rest);
1676                         QUIT;
1677                 }
1678                 if (!NILP(rest))
1679                         signal_simple_error("List must be nil-terminated",
1680                                             spec);
1681
1682                 define_key_check_and_coerce_keysym(spec, &keysym, modifiers);
1683                 returned_value->keysym = keysym;
1684                 returned_value->modifiers = modifiers;
1685         } else {
1686                 signal_simple_error("Unknown key-sequence specifier", spec);
1687         }
1688 }
1689
1690 /* Used by character-to-event */
1691 void
1692 key_desc_list_to_event(Lisp_Object list, Lisp_Object event,
1693                        int allow_menu_events)
1694 {
1695         struct key_data raw_key;
1696
1697         if (allow_menu_events && CONSP(list) &&
1698             /* #### where the hell does this come from? */
1699             EQ(XCAR(list), Qmenu_selection)) {
1700                 Lisp_Object fn, arg;
1701                 if (!NILP(Fcdr(Fcdr(list))))
1702                         signal_simple_error("Invalid menu event desc", list);
1703                 arg = Fcar(Fcdr(list));
1704                 if (SYMBOLP(arg))
1705                         fn = Qcall_interactively;
1706                 else
1707                         fn = Qeval;
1708                 XSETFRAME(XEVENT(event)->channel, selected_frame());
1709                 XEVENT(event)->event_type = misc_user_event;
1710                 XEVENT(event)->event.eval.function = fn;
1711                 XEVENT(event)->event.eval.object = arg;
1712                 return;
1713         }
1714
1715         define_key_parser(list, &raw_key);
1716
1717         if (EQ(raw_key.keysym, Qbutton0) || EQ(raw_key.keysym, Qbutton0up) ||
1718             EQ(raw_key.keysym, Qbutton1) || EQ(raw_key.keysym, Qbutton1up) ||
1719             EQ(raw_key.keysym, Qbutton2) || EQ(raw_key.keysym, Qbutton2up) ||
1720             EQ(raw_key.keysym, Qbutton3) || EQ(raw_key.keysym, Qbutton3up) ||
1721             EQ(raw_key.keysym, Qbutton4) || EQ(raw_key.keysym, Qbutton4up) ||
1722             EQ(raw_key.keysym, Qbutton5) || EQ(raw_key.keysym, Qbutton5up) ||
1723             EQ(raw_key.keysym, Qbutton6) || EQ(raw_key.keysym, Qbutton6up) ||
1724             EQ(raw_key.keysym, Qbutton7) || EQ(raw_key.keysym, Qbutton7up) ||
1725             EQ(raw_key.keysym, Qbutton8) || EQ(raw_key.keysym, Qbutton8up) ||
1726             EQ(raw_key.keysym, Qbutton9) || EQ(raw_key.keysym, Qbutton9up) ||
1727             EQ(raw_key.keysym, Qbutton10) || EQ(raw_key.keysym, Qbutton10up) ||
1728             EQ(raw_key.keysym, Qbutton11) || EQ(raw_key.keysym, Qbutton11up) ||
1729             EQ(raw_key.keysym, Qbutton12) || EQ(raw_key.keysym, Qbutton12up) ||
1730             EQ(raw_key.keysym, Qbutton13) || EQ(raw_key.keysym, Qbutton13up) ||
1731             EQ(raw_key.keysym, Qbutton14) || EQ(raw_key.keysym, Qbutton14up) ||
1732             EQ(raw_key.keysym, Qbutton15) || EQ(raw_key.keysym, Qbutton15up) ||
1733             EQ(raw_key.keysym, Qbutton16) || EQ(raw_key.keysym, Qbutton16up) ||
1734             EQ(raw_key.keysym, Qbutton17) || EQ(raw_key.keysym, Qbutton17up) ||
1735             EQ(raw_key.keysym, Qbutton18) || EQ(raw_key.keysym, Qbutton18up) ||
1736             EQ(raw_key.keysym, Qbutton19) || EQ(raw_key.keysym, Qbutton19up) ||
1737             EQ(raw_key.keysym, Qbutton20) || EQ(raw_key.keysym, Qbutton20up) ||
1738             EQ(raw_key.keysym, Qbutton21) || EQ(raw_key.keysym, Qbutton21up) ||
1739             EQ(raw_key.keysym, Qbutton22) || EQ(raw_key.keysym, Qbutton22up) ||
1740             EQ(raw_key.keysym, Qbutton23) || EQ(raw_key.keysym, Qbutton23up) ||
1741             EQ(raw_key.keysym, Qbutton24) || EQ(raw_key.keysym, Qbutton24up) ||
1742             EQ(raw_key.keysym, Qbutton25) || EQ(raw_key.keysym, Qbutton25up) ||
1743             EQ(raw_key.keysym, Qbutton26) || EQ(raw_key.keysym, Qbutton26up) ||
1744             EQ(raw_key.keysym, Qbutton27) || EQ(raw_key.keysym, Qbutton27up) ||
1745             EQ(raw_key.keysym, Qbutton28) || EQ(raw_key.keysym, Qbutton28up) ||
1746             EQ(raw_key.keysym, Qbutton29) || EQ(raw_key.keysym, Qbutton29up) ||
1747             EQ(raw_key.keysym, Qbutton30) || EQ(raw_key.keysym, Qbutton30up) ||
1748             EQ(raw_key.keysym, Qbutton31) || EQ(raw_key.keysym, Qbutton31up) ||
1749             EQ(raw_key.keysym, Qbutton32) || EQ(raw_key.keysym, Qbutton32up))
1750                 error("Mouse-clicks can't appear in saved keyboard macros.");
1751
1752         XEVENT(event)->channel = Vselected_console;
1753         XEVENT(event)->event_type = key_press_event;
1754         XEVENT(event)->event.key.keysym = raw_key.keysym;
1755         XEVENT(event)->event.key.modifiers = raw_key.modifiers;
1756 }
1757
1758 int event_matches_key_specifier_p(Lisp_Event * event, Lisp_Object key_specifier)
1759 {
1760         Lisp_Object event2 = Qnil;
1761         int retval;
1762         struct gcpro gcpro1;
1763
1764         if (event->event_type != key_press_event || NILP(key_specifier) ||
1765             (INTP(key_specifier) && !CHAR_INTP(key_specifier)))
1766                 return 0;
1767
1768         /* if the specifier is an integer such as 27, then it should match
1769            both of the events 'escape' and 'control ['.  Calling
1770            Fcharacter_to_event() will only match 'escape'. */
1771         if (CHAR_OR_CHAR_INTP(key_specifier))
1772                 return (XCHAR_OR_CHAR_INT(key_specifier)
1773                         == event_to_character(event, 0, 0, 0));
1774
1775         /* Otherwise, we cannot call event_to_character() because we may
1776            be dealing with non-ASCII keystrokes.  In any case, if I ask
1777            for 'control [' then I should get exactly that, and not
1778            'escape'.
1779
1780            However, we have to behave differently on TTY's, where 'control ['
1781            is silently converted into 'escape' by the keyboard driver.
1782            In this case, ASCII is the only thing we know about, so we have
1783            to compare the ASCII values. */
1784
1785         GCPRO1(event2);
1786         event2 = Fmake_event(Qnil, Qnil);
1787         Fcharacter_to_event(key_specifier, event2, Qnil, Qnil);
1788         if (XEVENT(event2)->event_type != key_press_event)
1789                 retval = 0;
1790         else if (CONSOLE_TTY_P(XCONSOLE(EVENT_CHANNEL(event)))) {
1791                 int ch1, ch2;
1792
1793                 ch1 = event_to_character(event, 0, 0, 0);
1794                 ch2 = event_to_character(XEVENT(event2), 0, 0, 0);
1795                 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1796         } else if (EQ(event->event.key.keysym, XEVENT(event2)->event.key.keysym)
1797                    && event->event.key.modifiers ==
1798                    XEVENT(event2)->event.key.modifiers)
1799                 retval = 1;
1800         else
1801                 retval = 0;
1802         Fdeallocate_event(event2);
1803         UNGCPRO;
1804         return retval;
1805 }
1806
1807 static int meta_prefix_char_p(const struct key_data *key)
1808 {
1809         Lisp_Event event;
1810
1811         event.event_type = key_press_event;
1812         event.channel = Vselected_console;
1813         event.event.key.keysym = key->keysym;
1814         event.event.key.modifiers = key->modifiers;
1815         return event_matches_key_specifier_p(&event, Vmeta_prefix_char);
1816 }
1817
1818 DEFUN("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1819 Return non-nil if EVENT matches KEY-SPECIFIER.
1820 This can be useful, e.g., to determine if the user pressed `help-char' or
1821 `quit-char'.
1822 */
1823       (event, key_specifier))
1824 {
1825         CHECK_LIVE_EVENT(event);
1826         return (event_matches_key_specifier_p(XEVENT(event), key_specifier)
1827                 ? Qt : Qnil);
1828 }
1829
1830 #define MACROLET(k,m) do {              \
1831   returned_value->keysym = (k);         \
1832   returned_value->modifiers = (m);      \
1833   RETURN_SANS_WARNINGS;                 \
1834 } while (0)
1835
1836 /* ASCII grunge.
1837    Given a keysym, return another keysym/modifier pair which could be
1838    considered the same key in an ASCII world.  Backspace returns ^H, for
1839    example.
1840  */
1841 static void
1842 define_key_alternate_name(struct key_data *key, struct key_data *returned_value)
1843 {
1844         Lisp_Object keysym = key->keysym;
1845         int modifiers = key->modifiers;
1846         int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL));
1847         int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META));
1848         returned_value->keysym = Qnil;  /* By default, no "alternate" key */
1849         returned_value->modifiers = 0;
1850         if (modifiers_sans_meta == XEMACS_MOD_CONTROL) {
1851                 if (EQ(keysym, QKspace))
1852                         MACROLET(make_char('@'), modifiers);
1853                 else if (!CHARP(keysym))
1854                         return;
1855                 else
1856                         switch (XCHAR(keysym)) {
1857                         case '@':       /* c-@ => c-space */
1858                                 MACROLET(QKspace, modifiers);
1859                         case 'h':       /* c-h => backspace */
1860                                 MACROLET(QKbackspace, modifiers_sans_control);
1861                         case 'i':       /* c-i => tab */
1862                                 MACROLET(QKtab, modifiers_sans_control);
1863                         case 'j':       /* c-j => linefeed */
1864                                 MACROLET(QKlinefeed, modifiers_sans_control);
1865                         case 'm':       /* c-m => return */
1866                                 MACROLET(QKreturn, modifiers_sans_control);
1867                         case '[':       /* c-[ => escape */
1868                                 MACROLET(QKescape, modifiers_sans_control);
1869                         default:
1870                                 return;
1871                         }
1872         } else if (modifiers_sans_meta != 0)
1873                 return;
1874         else if (EQ(keysym, QKbackspace))       /* backspace => c-h */
1875                 MACROLET(make_char('h'), (modifiers | XEMACS_MOD_CONTROL));
1876         else if (EQ(keysym, QKtab))     /* tab => c-i */
1877                 MACROLET(make_char('i'), (modifiers | XEMACS_MOD_CONTROL));
1878         else if (EQ(keysym, QKlinefeed))        /* linefeed => c-j */
1879                 MACROLET(make_char('j'), (modifiers | XEMACS_MOD_CONTROL));
1880         else if (EQ(keysym, QKreturn))  /* return => c-m */
1881                 MACROLET(make_char('m'), (modifiers | XEMACS_MOD_CONTROL));
1882         else if (EQ(keysym, QKescape))  /* escape => c-[ */
1883                 MACROLET(make_char('['), (modifiers | XEMACS_MOD_CONTROL));
1884         else
1885                 return;
1886 #undef MACROLET
1887 }
1888
1889 static void
1890 ensure_meta_prefix_char_keymapp(Lisp_Object keys, int indx, Lisp_Object keymap)
1891 {
1892         /* This function can GC */
1893         Lisp_Object new_keys;
1894         int i;
1895         Lisp_Object mpc_binding;
1896         struct key_data meta_key;
1897
1898         if (NILP(Vmeta_prefix_char) ||
1899             (INTP(Vmeta_prefix_char) && !CHAR_INTP(Vmeta_prefix_char)))
1900                 return;
1901
1902         define_key_parser(Vmeta_prefix_char, &meta_key);
1903         mpc_binding = keymap_lookup_1(keymap, &meta_key, 0);
1904         if (NILP(mpc_binding) || !NILP(Fkeymapp(mpc_binding)))
1905                 return;
1906
1907         if (indx == 0)
1908                 new_keys = keys;
1909         else if (STRINGP(keys))
1910                 new_keys = Fsubstring(keys, Qzero, make_int(indx));
1911         else if (VECTORP(keys)) {
1912                 new_keys = make_vector(indx, Qnil);
1913                 for (i = 0; i < indx; i++)
1914                         XVECTOR_DATA(new_keys)[i] = XVECTOR_DATA(keys)[i];
1915         } else {
1916                 new_keys = Qnil;
1917                 abort();
1918         }
1919
1920         if (EQ(keys, new_keys)) {
1921                 Lisp_Object tmp1 = Fkey_description(keys);
1922                 Lisp_Object tmp2 = Fsingle_key_description(Vmeta_prefix_char);
1923                 error_with_frob(mpc_binding,
1924                                 "can't bind %s: %s has a non-keymap binding",
1925                                 (char *)XSTRING_DATA(tmp1),
1926                                 (char *)XSTRING_DATA(tmp2));
1927         } else {
1928                 Lisp_Object tmp1 = Fkey_description(keys);
1929                 Lisp_Object tmp2 = Fkey_description(new_keys);
1930                 Lisp_Object tmp3 = Fsingle_key_description(Vmeta_prefix_char);
1931                 error_with_frob(mpc_binding,
1932                                 "can't bind %s: %s %s has a non-keymap binding",
1933                                 (char *)XSTRING_DATA(tmp1),
1934                                 (char *)XSTRING_DATA(tmp2),
1935                                 (char *)XSTRING_DATA(tmp3));
1936         }
1937 }
1938
1939 DEFUN("define-key", Fdefine_key, 3, 3, 0,       /*
1940 Define key sequence KEYS, in KEYMAP, as DEF.
1941 KEYMAP is a keymap object.
1942 KEYS is the sequence of keystrokes to bind, described below.
1943 DEF is anything that can be a key's definition:
1944 nil (means key is undefined in this keymap);
1945 a command (a Lisp function suitable for interactive calling);
1946 a string or key sequence vector (treated as a keyboard macro);
1947 a keymap (to define a prefix key);
1948 a symbol; when the key is looked up, the symbol will stand for its
1949 function definition, that should at that time be one of the above,
1950 or another symbol whose function definition is used, and so on.
1951 a cons (STRING . DEFN), meaning that DEFN is the definition
1952 (DEFN should be a valid definition in its own right);
1953 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1954
1955 Contrary to popular belief, the world is not ASCII.  When running under a
1956 window manager, SXEmacs can tell the difference between, for example, the
1957 keystrokes control-h, control-shift-h, and backspace.  You can, in fact,
1958 bind different commands to each of these.
1959
1960 A `key sequence' is a set of keystrokes.  A `keystroke' is a keysym and some
1961 set of modifiers (such as control and meta).  A `keysym' is what is printed
1962 on the keys on your keyboard.
1963
1964 A keysym may be represented by a symbol, or (if and only if it is equivalent
1965 to an ASCII character in the range 32 - 255) by a character or its equivalent
1966 ASCII code.  The `A' key may be represented by the symbol `A', the character
1967 `?A', or by the number 65.  The `break' key may be represented only by the
1968 symbol `break'.
1969
1970 A keystroke may be represented by a list: the last element of the list
1971 is the key (a symbol, character, or number, as above) and the
1972 preceding elements are the symbolic names of modifier keys (control,
1973 meta, super, hyper, alt, and shift).  Thus, the sequence control-b is
1974 represented by the forms `(control b)', `(control ?b)', and `(control
1975 98)'.  A keystroke may also be represented by an event object, as
1976 returned by the `next-command-event' and `read-key-sequence'
1977 functions.
1978
1979 Note that in this context, the keystroke `control-b' is *not* represented
1980 by the number 2 (the ASCII code for ^B) or the character `?\^B'.  See below.
1981
1982 The `shift' modifier is somewhat of a special case.  You should not (and
1983 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1984 have ASCII equivalents, the state of the shift key is implicit in the
1985 keysym (a vs. A).  You also cannot say `(shift =)' to mean `+', as that
1986 sort of thing varies from keyboard to keyboard.  The shift modifier is for
1987 use only with characters that do not have a second keysym on the same key,
1988 such as `backspace' and `tab'.
1989
1990 A key sequence is a vector of keystrokes.  As a degenerate case, elements
1991 of this vector may also be keysyms if they have no modifiers.  That is,
1992 the `A' keystroke is represented by all of these forms:
1993 A ?A      65      (A)     (?A)    (65)
1994 [A]       [?A]    [65]    [(A)]   [(?A)]  [(65)]
1995
1996 the `control-a' keystroke is represented by these forms:
1997 (control A)       (control ?A)    (control 65)
1998 [(control A)]     [(control ?A)]  [(control 65)]
1999 the key sequence `control-c control-a' is represented by these forms:
2000 [(control c) (control a)] [(control ?c) (control ?a)]
2001 [(control 99) (control 65)]       etc.
2002
2003 Mouse button clicks work just like keypresses: (control button1) means
2004 pressing the left mouse button while holding down the control key.
2005 \[(control c) (shift button3)] means control-c, hold shift, click right.
2006
2007 Commands may be bound to the mouse-button up-stroke rather than the down-
2008 stroke as well.  `button1' means the down-stroke, and `button1up' means the
2009 up-stroke.  Different commands may be bound to the up and down strokes,
2010 though that is probably not what you want, so be careful.
2011
2012 For backward compatibility, a key sequence may also be represented by a
2013 string.  In this case, it represents the key sequence(s) that would
2014 produce that sequence of ASCII characters in a purely ASCII world.  For
2015 example, a string containing the ASCII backspace character, "\\^H", would
2016 represent two key sequences: `(control h)' and `backspace'.  Binding a
2017 command to this will actually bind both of those key sequences.  Likewise
2018 for the following pairs:
2019
2020 control h backspace
2021 control i         tab
2022 control m         return
2023 control j         linefeed
2024 control [         escape
2025 control @ control space
2026
2027 After binding a command to two key sequences with a form like
2028
2029 (define-key global-map "\\^X\\^I" \'command-1)
2030
2031 it is possible to redefine only one of those sequences like so:
2032
2033 (define-key global-map [(control x) (control i)] \'command-2)
2034 (define-key global-map [(control x) tab] \'command-3)
2035
2036 Of course, all of this applies only when running under a window system.  If
2037 you're talking to SXEmacs through a TTY connection, you don't get any of
2038 these features.
2039 */
2040       (keymap, keys, def))
2041 {
2042         /* This function can GC */
2043         int idx;
2044         int metized = 0;
2045         int len;
2046         int ascii_hack;
2047         struct gcpro gcpro1, gcpro2, gcpro3;
2048
2049         if (VECTORP(keys))
2050                 len = XVECTOR_LENGTH(keys);
2051         else if (STRINGP(keys))
2052                 len = XSTRING_CHAR_LENGTH(keys);
2053         else if (CHAR_OR_CHAR_INTP(keys) || SYMBOLP(keys) || CONSP(keys)) {
2054                 if (!CONSP(keys))
2055                         keys = list1(keys);
2056                 len = 1;
2057                 keys = make_vector(1, keys);    /* this is kinda sleazy. */
2058         } else {
2059                 keys = wrong_type_argument(Qsequencep, keys);
2060                 len = XINT(Flength(keys));
2061         }
2062         if (len == 0)
2063                 return Qnil;
2064
2065         GCPRO3(keymap, keys, def);
2066
2067         /* ASCII grunge.
2068            When the user defines a key which, in a strictly ASCII world, would be
2069            produced by two different keys (^J and linefeed, or ^H and backspace,
2070            for example) then the binding will be made for both keysyms.
2071
2072            This is done if the user binds a command to a string, as in
2073            (define-key map "\^H" 'something), but not when using one of the new
2074            syntaxes, like (define-key map '(control h) 'something).
2075          */
2076         ascii_hack = (STRINGP(keys));
2077
2078         keymap = get_keymap(keymap, 1, 1);
2079
2080         idx = 0;
2081         while (1) {
2082                 Lisp_Object c;
2083                 struct key_data raw_key1;
2084                 struct key_data raw_key2;
2085
2086                 if (STRINGP(keys))
2087                         c = make_char(string_char(XSTRING(keys), idx));
2088                 else
2089                         c = XVECTOR_DATA(keys)[idx];
2090
2091                 define_key_parser(c, &raw_key1);
2092
2093                 if (!metized && ascii_hack && meta_prefix_char_p(&raw_key1)) {
2094                         if (idx == (len - 1)) {
2095                                 /* This is a hack to prevent a binding for the meta-prefix-char
2096                                    from being made in a map which already has a non-empty "meta"
2097                                    submap.  That is, we can't let both "escape" and "meta" have
2098                                    a binding in the same keymap.  This implies that the idiom
2099                                    (define-key my-map "\e" my-escape-map)
2100                                    (define-key my-escape-map "a" 'my-command)
2101                                    no longer works.  That's ok.  Instead the luser should do
2102                                    (define-key my-map "\ea" 'my-command)
2103                                    or, more correctly
2104                                    (define-key my-map "\M-a" 'my-command)
2105                                    and then perhaps
2106                                    (defvar my-escape-map (lookup-key my-map "\e"))
2107                                    if the luser really wants the map in a variable.
2108                                  */
2109                                 Lisp_Object meta_map;
2110                                 struct gcpro ngcpro1;
2111
2112                                 NGCPRO1(c);
2113                                 meta_map =
2114                                     Fgethash(MAKE_MODIFIER_HASH_KEY
2115                                              (XEMACS_MOD_META),
2116                                              XKEYMAP(keymap)->table, Qnil);
2117                                 if (!NILP(meta_map)
2118                                     && keymap_fullness(meta_map) != 0)
2119                                         signal_simple_error_2
2120                                             ("Map contains meta-bindings, can't bind",
2121                                              Fsingle_key_description
2122                                              (Vmeta_prefix_char), keymap);
2123                                 NUNGCPRO;
2124                         } else {
2125                                 metized = 1;
2126                                 idx++;
2127                                 continue;
2128                         }
2129                 }
2130
2131                 if (ascii_hack)
2132                         define_key_alternate_name(&raw_key1, &raw_key2);
2133                 else {
2134                         raw_key2.keysym = Qnil;
2135                         raw_key2.modifiers = 0;
2136                 }
2137
2138                 if (metized) {
2139                         raw_key1.modifiers |= XEMACS_MOD_META;
2140                         raw_key2.modifiers |= XEMACS_MOD_META;
2141                         metized = 0;
2142                 }
2143
2144                 /* This crap is to make sure that someone doesn't bind something like
2145                    "C-x M-a" while "C-x ESC" has a non-keymap binding. */
2146                 if (raw_key1.modifiers & XEMACS_MOD_META)
2147                         ensure_meta_prefix_char_keymapp(keys, idx, keymap);
2148
2149                 if (++idx == len) {
2150                         keymap_store(keymap, &raw_key1, def);
2151                         if (ascii_hack && !NILP(raw_key2.keysym))
2152                                 keymap_store(keymap, &raw_key2, def);
2153                         UNGCPRO;
2154                         return def;
2155                 }
2156
2157                 {
2158                         Lisp_Object cmd;
2159                         struct gcpro ngcpro1;
2160                         NGCPRO1(c);
2161
2162                         cmd = keymap_lookup_1(keymap, &raw_key1, 0);
2163                         if (NILP(cmd)) {
2164                                 cmd = Fmake_sparse_keymap(Qnil);
2165                                 XKEYMAP(cmd)->name      /* for debugging */
2166                                     = list2(make_key_description(&raw_key1, 1),
2167                                             keymap);
2168                                 keymap_store(keymap, &raw_key1, cmd);
2169                         }
2170                         if (NILP(Fkeymapp(cmd)))
2171                                 signal_simple_error_2
2172                                     ("Invalid prefix keys in sequence", c,
2173                                      keys);
2174
2175                         if (ascii_hack && !NILP(raw_key2.keysym) &&
2176                             NILP(keymap_lookup_1(keymap, &raw_key2, 0)))
2177                                 keymap_store(keymap, &raw_key2, cmd);
2178
2179                         keymap = get_keymap(cmd, 1, 1);
2180                         NUNGCPRO;
2181                 }
2182         }
2183 }
2184 \f
2185 /************************************************************************/
2186 /*                      Looking up keys in keymaps                      */
2187 /************************************************************************/
2188
2189 /* We need a very fast (i.e., non-consing) version of lookup-key in order
2190    to make where-is-internal really fly. */
2191
2192 struct raw_lookup_key_mapper_closure {
2193         int remaining;
2194         const struct key_data *raw_keys;
2195         int raw_keys_count;
2196         int keys_so_far;
2197         int accept_default;
2198 };
2199
2200 static Lisp_Object raw_lookup_key_mapper(Lisp_Object k, void*);
2201
2202 /* Caller should gc-protect args (keymaps may autoload) */
2203 static Lisp_Object
2204 raw_lookup_key(Lisp_Object keymap,
2205                const struct key_data *raw_keys, int raw_keys_count,
2206                int keys_so_far, int accept_default)
2207 {
2208         /* This function can GC */
2209         struct raw_lookup_key_mapper_closure c;
2210         c.remaining = raw_keys_count - 1;
2211         c.raw_keys = raw_keys;
2212         c.raw_keys_count = raw_keys_count;
2213         c.keys_so_far = keys_so_far;
2214         c.accept_default = accept_default;
2215
2216         return traverse_keymaps(keymap, Qnil, raw_lookup_key_mapper, &c);
2217 }
2218
2219 static Lisp_Object
2220 raw_lookup_key_mapper(Lisp_Object k, void *arg)
2221 {
2222         /* This function can GC */
2223         const struct raw_lookup_key_mapper_closure *c =
2224                 (const struct raw_lookup_key_mapper_closure*)arg;
2225         int accept_default = c->accept_default;
2226         int remaining = c->remaining;
2227         int keys_so_far = c->keys_so_far;
2228         const struct key_data *raw_keys = c->raw_keys;
2229         Lisp_Object cmd;
2230
2231         if (!meta_prefix_char_p(&(raw_keys[0]))) {
2232                 /* Normal case: every case except the meta-hack (see below). */
2233                 cmd = keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2234
2235                 if (remaining == 0)
2236                         /* Return whatever we found if we're out of keys */
2237                         ;
2238                 else if (NILP(cmd))
2239                         /* Found nothing (though perhaps parent map may have
2240                            binding) */
2241                         ;
2242                 else if (NILP(Fkeymapp(cmd)))
2243                         /* Didn't find a keymap, and we have more keys.
2244                          * Return a fixnum to indicate that keys were too long.
2245                          */
2246                         cmd = make_int(keys_so_far + 1);
2247                 else
2248                         cmd = raw_lookup_key(cmd, raw_keys + 1, remaining,
2249                                              keys_so_far + 1, accept_default);
2250         } else {
2251                 /* This is a hack so that looking up a key-sequence whose last
2252                  * element is the meta-prefix-char will return the keymap that
2253                  * the "meta" keys are stored in, if there is no binding for
2254                  * the meta-prefix-char (and if this map has a "meta" submap).
2255                  * If this map doesn't have a "meta" submap, then the
2256                  * meta-prefix-char is looked up just like any other key.
2257                  */
2258                 if (remaining == 0) {
2259                         /* First look for the prefix-char directly */
2260                         cmd =
2261                             keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2262                         if (NILP(cmd)) {
2263                                 /* Do kludgy return of the meta-map */
2264                                 cmd =
2265                                     Fgethash(MAKE_MODIFIER_HASH_KEY
2266                                              (XEMACS_MOD_META),
2267                                              XKEYMAP(k)->table, Qnil);
2268                         }
2269                 } else {
2270                         /* Search for the prefix-char-prefixed sequence
2271                            directly */
2272                         cmd =
2273                             keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2274                         cmd = get_keymap(cmd, 0, 1);
2275                         if (!NILP(cmd))
2276                                 cmd =
2277                                     raw_lookup_key(cmd, raw_keys + 1, remaining,
2278                                                    keys_so_far + 1,
2279                                                    accept_default);
2280                         else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0) {
2281                                 struct key_data metified;
2282                                 metified.keysym = raw_keys[1].keysym;
2283                                 metified.modifiers = raw_keys[1].modifiers |
2284                                     (unsigned char)XEMACS_MOD_META;
2285
2286                                 /* Search for meta-next-char sequence directly */
2287                                 cmd =
2288                                     keymap_lookup_1(k, &metified,
2289                                                     accept_default);
2290                                 if (remaining == 1) ;
2291                                 else {
2292                                         cmd = get_keymap(cmd, 0, 1);
2293                                         if (!NILP(cmd))
2294                                                 cmd =
2295                                                     raw_lookup_key(cmd,
2296                                                                    raw_keys + 2,
2297                                                                    remaining -
2298                                                                    1,
2299                                                                    keys_so_far +
2300                                                                    2,
2301                                                                    accept_default);
2302                                 }
2303                         }
2304                 }
2305         }
2306         if (accept_default && NILP(cmd))
2307                 cmd = XKEYMAP(k)->default_binding;
2308         return cmd;
2309 }
2310
2311 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2312 /* Caller should gc-protect arguments */
2313 static Lisp_Object
2314 lookup_keys(Lisp_Object keymap, int nkeys, Lisp_Object * keys,
2315             int accept_default)
2316 {
2317         /* This function can GC */
2318         struct key_data kkk[20];
2319         struct key_data *raw_keys;
2320         int i;
2321
2322         if (nkeys == 0)
2323                 return Qnil;
2324
2325         if (nkeys < countof(kkk))
2326                 raw_keys = kkk;
2327         else
2328                 raw_keys = alloca_array(struct key_data, nkeys);
2329
2330         for (i = 0; i < nkeys; i++) {
2331                 define_key_parser(keys[i], &(raw_keys[i]));
2332         }
2333         return raw_lookup_key(keymap, raw_keys, nkeys, 0, accept_default);
2334 }
2335
2336 static Lisp_Object
2337 lookup_events(Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2338               int accept_default)
2339 {
2340         /* This function can GC */
2341         struct key_data kkk[20];
2342         Lisp_Object event;
2343
2344         int nkeys;
2345         struct key_data *raw_keys;
2346         Lisp_Object tem = Qnil;
2347         struct gcpro gcpro1, gcpro2;
2348         int iii;
2349
2350         CHECK_LIVE_EVENT(event_head);
2351
2352         nkeys = event_chain_count(event_head);
2353
2354         if (nkeys < countof(kkk))
2355                 raw_keys = kkk;
2356         else
2357                 raw_keys = alloca_array(struct key_data, nkeys);
2358
2359         nkeys = 0;
2360         EVENT_CHAIN_LOOP(event, event_head)
2361             define_key_parser(event, &(raw_keys[nkeys++]));
2362         GCPRO1n(event_head, keymaps, nmaps);
2363         /* ####raw_keys[].keysym slots aren't gc-protected.
2364          * We rely (but shouldn't) on somebody else somewhere (obarray)
2365          * having a pointer to all keysyms. */
2366         for (iii = 0; iii < nmaps; iii++) {
2367                 tem = raw_lookup_key(keymaps[iii], raw_keys, nkeys, 0,
2368                                      accept_default);
2369                 if (INTP(tem)) {
2370                         /* Too long in some local map means don't look at global map */
2371                         tem = Qnil;
2372                         break;
2373                 } else if (!NILP(tem)) {
2374                         break;
2375                 }
2376         }
2377         UNGCPRO;
2378         return tem;
2379 }
2380
2381 DEFUN("lookup-key", Flookup_key, 2, 3, 0,       /*
2382 In keymap KEYMAP, look up key-sequence KEYS.  Return the definition.
2383 Nil is returned if KEYS is unbound.  See documentation of `define-key'
2384 for valid key definitions and key-sequence specifications.
2385 A number is returned if KEYS is "too long"; that is, the leading
2386 characters fail to be a valid sequence of prefix characters in KEYMAP.
2387 The number is how many key strokes at the front of KEYS it takes to
2388 reach a non-prefix command.
2389 */
2390       (keymap, keys, accept_default))
2391 {
2392         /* This function can GC */
2393         if (VECTORP(keys))
2394                 return lookup_keys(keymap,
2395                                    XVECTOR_LENGTH(keys),
2396                                    XVECTOR_DATA(keys), !NILP(accept_default));
2397         else if (SYMBOLP(keys) || CHAR_OR_CHAR_INTP(keys) || CONSP(keys))
2398                 return lookup_keys(keymap, 1, &keys, !NILP(accept_default));
2399         else if (STRINGP(keys)) {
2400                 int length = XSTRING_CHAR_LENGTH(keys);
2401                 int i;
2402                 struct key_data *raw_keys =
2403                     alloca_array(struct key_data, length);
2404                 if (length == 0)
2405                         return Qnil;
2406
2407                 for (i = 0; i < length; i++) {
2408                         Emchar n = string_char(XSTRING(keys), i);
2409                         define_key_parser(make_char(n), &(raw_keys[i]));
2410                 }
2411                 return raw_lookup_key(keymap, raw_keys, length, 0,
2412                                       !NILP(accept_default));
2413         } else {
2414                 keys = wrong_type_argument(Qsequencep, keys);
2415                 return Flookup_key(keymap, keys, accept_default);
2416         }
2417 }
2418
2419 /* Given a key sequence, returns a list of keymaps to search for bindings.
2420    Does all manner of semi-hairy heuristics, like looking in the current
2421    buffer's map before looking in the global map and looking in the local
2422    map of the buffer in which the mouse was clicked in event0 is a click.
2423
2424    It would be kind of nice if this were in Lisp so that this semi-hairy
2425    semi-heuristic command-lookup behavior could be readily understood and
2426    customised.  However, this needs to be pretty fast, or performance of
2427    keyboard macros goes to shit; putting this in lisp slows macros down
2428    2-3x.  And they're already slower than v18 by 5-6x.
2429  */
2430
2431 struct relevant_maps {
2432         int nmaps;
2433         unsigned int max_maps;
2434         Lisp_Object *maps;
2435         struct gcpro *gcpro;
2436 };
2437
2438 static void get_relevant_extent_keymaps(Lisp_Object pos,
2439                                         Lisp_Object buffer_or_string,
2440                                         Lisp_Object glyph,
2441                                         struct relevant_maps *closure);
2442 static void get_relevant_minor_maps(Lisp_Object buffer,
2443                                     struct relevant_maps *closure);
2444
2445 static void relevant_map_push(Lisp_Object map, struct relevant_maps *closure)
2446 {
2447         unsigned int nmaps = closure->nmaps;
2448
2449         if (!KEYMAPP(map))
2450                 return;
2451         closure->nmaps = nmaps + 1;
2452         if (nmaps < closure->max_maps) {
2453                 closure->maps[nmaps] = map;
2454 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
2455                 closure->gcpro->nvars = nmaps;
2456 #endif  /* !BDWGC */
2457         }
2458 }
2459
2460 static int
2461 get_relevant_keymaps(Lisp_Object keys, int max_maps, Lisp_Object maps[])
2462 {
2463         /* This function can GC */
2464         Lisp_Object terminal = Qnil;
2465         struct gcpro gcpro1;
2466         struct relevant_maps closure;
2467         struct console *con;
2468
2469         GCPROn(maps, 0);
2470         closure.nmaps = 0;
2471         closure.max_maps = max_maps;
2472         closure.maps = maps;
2473 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
2474         closure.gcpro = NULL;
2475 #else  /* !BDWGC */
2476         closure.gcpro = &gcpro1;
2477 #endif  /* BDWGC */
2478
2479         if (EVENTP(keys)) {
2480                 terminal = event_chain_tail(keys);
2481         } else if (VECTORP(keys)) {
2482                 int len = XVECTOR_LENGTH(keys);
2483                 if (len > 0) {
2484                         terminal = XVECTOR_DATA(keys)[len - 1];
2485                 }
2486         }
2487
2488         if (EVENTP(terminal)) {
2489                 CHECK_LIVE_EVENT(terminal);
2490                 con = event_console_or_selected(terminal);
2491         } else {
2492                 con = XCONSOLE(Vselected_console);
2493         }
2494
2495         if (KEYMAPP(con->overriding_terminal_local_map)
2496             || KEYMAPP(Voverriding_local_map)) {
2497                 if (KEYMAPP(con->overriding_terminal_local_map))
2498                         relevant_map_push(con->overriding_terminal_local_map,
2499                                           &closure);
2500                 if (KEYMAPP(Voverriding_local_map))
2501                         relevant_map_push(Voverriding_local_map, &closure);
2502         } else if (!EVENTP(terminal) ||
2503                    (XEVENT(terminal)->event_type != button_press_event
2504                     && XEVENT(terminal)->event_type != button_release_event)) {
2505                 Lisp_Object tem;
2506                 XSETBUFFER(tem, current_buffer);
2507                 /* It's not a mouse event; order of keymaps searched is:
2508                    o  keymap of any/all extents under the mouse
2509                    o  minor-mode maps
2510                    o  local-map of current-buffer
2511                    o  global-map
2512                  */
2513                 /* The terminal element of the lookup may be nil or a keysym.
2514                    In those cases we don't want to check for an extent
2515                    keymap. */
2516                 if (EVENTP(terminal)) {
2517                         get_relevant_extent_keymaps(make_int
2518                                                     (BUF_PT(current_buffer)),
2519                                                     tem, Qnil, &closure);
2520                 }
2521                 get_relevant_minor_maps(tem, &closure);
2522
2523                 tem = current_buffer->keymap;
2524                 if (!NILP(tem))
2525                         relevant_map_push(tem, &closure);
2526         }
2527 #ifdef HAVE_WINDOW_SYSTEM
2528         else {
2529                 /* It's a mouse event; order of keymaps searched is:
2530                    o  vertical-divider-map, if event is over a divider
2531                    o  local-map of mouse-grabbed-buffer
2532                    o  keymap of any/all extents under the mouse
2533                    if the mouse is over a modeline:
2534                    o  modeline-map of buffer corresponding to that modeline
2535                    o  else, local-map of buffer under the mouse
2536                    o  minor-mode maps
2537                    o  local-map of current-buffer
2538                    o  global-map
2539                  */
2540                 Lisp_Object window = Fevent_window(terminal);
2541
2542                 if (!NILP(Fevent_over_vertical_divider_p(terminal))) {
2543                         if (KEYMAPP(Vvertical_divider_map))
2544                                 relevant_map_push(Vvertical_divider_map,
2545                                                   &closure);
2546                 }
2547
2548                 if (BUFFERP(Vmouse_grabbed_buffer)) {
2549                         Lisp_Object map =
2550                             XBUFFER(Vmouse_grabbed_buffer)->keymap;
2551
2552                         get_relevant_minor_maps(Vmouse_grabbed_buffer,
2553                                                 &closure);
2554                         if (!NILP(map))
2555                                 relevant_map_push(map, &closure);
2556                 }
2557
2558                 if (!NILP(window)) {
2559                         Lisp_Object buffer = Fwindow_buffer(window);
2560
2561                         if (!NILP(buffer)) {
2562                                 if (!NILP(Fevent_over_modeline_p(terminal))) {
2563                                         Lisp_Object map =
2564                                             symbol_value_in_buffer
2565                                             (Qmodeline_map,
2566                                              buffer);
2567
2568                                         get_relevant_extent_keymaps
2569                                             (Fevent_modeline_position(terminal),
2570                                              XBUFFER(buffer)->
2571                                              generated_modeline_string,
2572                                              Fevent_glyph_extent(terminal),
2573                                              &closure);
2574
2575                                         if (!UNBOUNDP(map) && !NILP(map))
2576                                                 relevant_map_push(get_keymap
2577                                                                   (map, 1, 1),
2578                                                                   &closure);
2579                                 } else {
2580                                         get_relevant_extent_keymaps(Fevent_point
2581                                                                     (terminal),
2582                                                                     buffer,
2583                                                                     Fevent_glyph_extent
2584                                                                     (terminal),
2585                                                                     &closure);
2586                                 }
2587
2588                                 if (!EQ(buffer, Vmouse_grabbed_buffer)) {       /* already pushed */
2589                                         Lisp_Object map =
2590                                             XBUFFER(buffer)->keymap;
2591
2592                                         get_relevant_minor_maps(buffer,
2593                                                                 &closure);
2594                                         if (!NILP(map))
2595                                                 relevant_map_push(map,
2596                                                                   &closure);
2597                                 }
2598                         }
2599                 } else if (!NILP(Fevent_over_toolbar_p(terminal))) {
2600                         Lisp_Object map = Fsymbol_value(Qtoolbar_map);
2601
2602                         if (!UNBOUNDP(map) && !NILP(map))
2603                                 relevant_map_push(map, &closure);
2604                 }
2605         }
2606 #endif                          /* HAVE_WINDOW_SYSTEM */
2607
2608         if (CONSOLE_TTY_P (con))
2609                 relevant_map_push (Vglobal_tty_map, &closure);
2610         else
2611                 relevant_map_push (Vglobal_window_system_map, &closure);
2612   
2613         {
2614                 int nmaps = closure.nmaps;
2615                 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2616                 if (nmaps >= max_maps && max_maps > 0)
2617                         maps[max_maps - 1] = Vcurrent_global_map;
2618                 else
2619                         maps[nmaps] = Vcurrent_global_map;
2620                 UNGCPRO;
2621                 return nmaps + 1;
2622         }
2623 }
2624
2625 /* Returns a set of keymaps extracted from the extents at POS in
2626    BUFFER_OR_STRING.  The GLYPH arg, if specified, is one more extent
2627    to look for a keymap in, and if it has one, its keymap will be the
2628    first element in the list returned.  This is so we can correctly
2629    search the keymaps associated with glyphs which may be physically
2630    disjoint from their extents: for example, if a glyph is out in the
2631    margin, we should still consult the keymap of that glyph's extent,
2632    which may not itself be under the mouse.
2633  */
2634
2635 static void
2636 get_relevant_extent_keymaps(Lisp_Object pos, Lisp_Object buffer_or_string,
2637                             Lisp_Object glyph, struct relevant_maps *closure)
2638 {
2639         /* This function can GC */
2640         /* the glyph keymap, if any, comes first.
2641            (Processing it twice is no big deal: noop.) */
2642         if (!NILP(glyph)) {
2643                 Lisp_Object keymap = Fextent_property(glyph, Qkeymap, Qnil);
2644                 if (!NILP(keymap))
2645                         relevant_map_push(get_keymap(keymap, 1, 1), closure);
2646         }
2647
2648         /* Next check the extents at the text position, if any */
2649         if (!NILP(pos)) {
2650                 Lisp_Object extent;
2651                 for (extent =
2652                      Fextent_at(pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2653                      !NILP(extent);
2654                      extent =
2655                      Fextent_at(pos, buffer_or_string, Qkeymap, extent, Qnil)) {
2656                         Lisp_Object keymap =
2657                             Fextent_property(extent, Qkeymap, Qnil);
2658                         if (!NILP(keymap))
2659                                 relevant_map_push(get_keymap(keymap, 1, 1),
2660                                                   closure);
2661                         QUIT;
2662                 }
2663         }
2664 }
2665
2666 static Lisp_Object
2667 minor_mode_keymap_predicate(Lisp_Object assoc, Lisp_Object buffer)
2668 {
2669         /* This function can GC */
2670         if (CONSP(assoc)) {
2671                 Lisp_Object sym = XCAR(assoc);
2672                 if (SYMBOLP(sym)) {
2673                         Lisp_Object val = symbol_value_in_buffer(sym, buffer);
2674                         if (!NILP(val) && !UNBOUNDP(val)) {
2675                                 Lisp_Object map = get_keymap(XCDR(assoc), 0, 1);
2676                                 return map;
2677                         }
2678                 }
2679         }
2680         return Qnil;
2681 }
2682
2683 static void
2684 get_relevant_minor_maps(Lisp_Object buffer, struct relevant_maps *closure)
2685 {
2686         /* This function can GC */
2687         Lisp_Object alist;
2688
2689         /* Will you ever lose badly if you make this circular! */
2690         for (alist = symbol_value_in_buffer(Qminor_mode_map_alist, buffer);
2691              CONSP(alist); alist = XCDR(alist)) {
2692                 Lisp_Object m = minor_mode_keymap_predicate(XCAR(alist),
2693                                                             buffer);
2694                 if (!NILP(m))
2695                         relevant_map_push(m, closure);
2696                 QUIT;
2697         }
2698 }
2699
2700 /* #### Would map-current-keymaps be a better thing?? */
2701 DEFUN("current-keymaps", Fcurrent_keymaps, 0, 1, 0,     /*
2702 Return a list of the current keymaps that will be searched for bindings.
2703 This lists keymaps such as the current local map and the minor-mode maps,
2704 but does not list the parents of those keymaps.
2705 EVENT-OR-KEYS controls which keymaps will be listed.
2706 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2707 mouse event), the keymaps for that mouse event will be listed (see
2708 `key-binding').  Otherwise, the keymaps for key presses will be listed.
2709 */
2710       (event_or_keys))
2711 {
2712         /* This function can GC */
2713         struct gcpro gcpro1;
2714         Lisp_Object maps[100];
2715         Lisp_Object *gubbish = maps;
2716         int nmaps;
2717
2718         GCPRO1(event_or_keys);
2719         nmaps = get_relevant_keymaps(event_or_keys, countof(maps), gubbish);
2720         if (nmaps > countof(maps)) {
2721                 gubbish = alloca_array(Lisp_Object, nmaps);
2722                 nmaps = get_relevant_keymaps(event_or_keys, nmaps, gubbish);
2723         }
2724         UNGCPRO;
2725         return Flist(nmaps, gubbish);
2726 }
2727
2728 DEFUN("key-binding", Fkey_binding, 1, 2, 0,     /*
2729 Return the binding for command KEYS in current keymaps.
2730 KEYS is a string, a vector of events, or a vector of key-description lists
2731 as described in the documentation for the `define-key' function.
2732 The binding is probably a symbol with a function definition; see
2733 the documentation for `lookup-key' for more information.
2734
2735 For key-presses, the order of keymaps searched is:
2736 - the `keymap' property of any extent(s) at point;
2737 - any applicable minor-mode maps;
2738 - the current local map of the current-buffer;
2739 - the current global map.
2740
2741 For mouse-clicks, the order of keymaps searched is:
2742 - the current-local-map of the `mouse-grabbed-buffer' if any;
2743 - vertical-divider-map, if the event happened over a vertical divider
2744 - the `keymap' property of any extent(s) at the position of the click
2745 (this includes modeline extents);
2746 - the modeline-map of the buffer corresponding to the modeline under
2747 the mouse (if the click happened over a modeline);
2748 - the value of `toolbar-map' in the current-buffer (if the click
2749 happened over a toolbar);
2750 - the current local map of the buffer under the mouse (does not
2751 apply to toolbar clicks);
2752 - any applicable minor-mode maps;
2753 - the current global map.
2754
2755 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2756 is non-nil, *only* those two maps and the current global map are searched.
2757 */
2758       (keys, accept_default))
2759 {
2760         /* This function can GC */
2761         int i;
2762         Lisp_Object maps[100];
2763         int nmaps;
2764         struct gcpro gcpro1, gcpro2;
2765         GCPRO2(keys, accept_default);   /* get_relevant_keymaps may autoload */
2766
2767         nmaps = get_relevant_keymaps(keys, countof(maps), maps);
2768
2769         UNGCPRO;
2770
2771         if (EVENTP(keys))       /* unadvertised "feature" for the future */
2772                 return lookup_events(keys, nmaps, maps, !NILP(accept_default));
2773
2774         for (i = 0; i < nmaps; i++) {
2775                 Lisp_Object tem = Flookup_key(maps[i], keys,
2776                                               accept_default);
2777                 if (INTP(tem)) {
2778                         /* Too long in some local map means don't look at global map */
2779                         return Qnil;
2780                 } else if (!NILP(tem))
2781                         return tem;
2782         }
2783         return Qnil;
2784 }
2785
2786 static Lisp_Object process_event_binding_result(Lisp_Object result)
2787 {
2788         if (EQ(result, Qundefined))
2789                 /* The suppress-keymap function binds keys to 'undefined - special-case
2790                    that here, so that being bound to that has the same error-behavior as
2791                    not being defined at all.
2792                  */
2793                 result = Qnil;
2794         if (!NILP(result)) {
2795                 Lisp_Object map;
2796                 /* Snap out possible keymap indirections */
2797                 map = get_keymap(result, 0, 1);
2798                 if (!NILP(map))
2799                         result = map;
2800         }
2801
2802         return result;
2803 }
2804
2805 /* Attempts to find a command corresponding to the event-sequence
2806    whose head is event0 (sequence is threaded though event_next).
2807
2808    The return value will be
2809
2810       -- nil (there is no binding; this will also be returned
2811               whenever the event chain is "too long", i.e. there
2812               is a non-nil, non-keymap binding for a prefix of
2813               the event chain)
2814       -- a keymap (part of a command has been specified)
2815       -- a command (anything that satisfies `commandp'; this includes
2816                     some symbols, lists, subrs, strings, vectors, and
2817                     compiled-function objects) */
2818 Lisp_Object event_binding(Lisp_Object event0, int accept_default)
2819 {
2820         /* This function can GC */
2821         Lisp_Object maps[100];
2822         int nmaps;
2823
2824         assert(EVENTP(event0));
2825
2826         nmaps = get_relevant_keymaps(event0, countof(maps), maps);
2827         if (nmaps > countof(maps))
2828                 nmaps = countof(maps);
2829         return process_event_binding_result(lookup_events(event0, nmaps, maps,
2830                                                           accept_default));
2831 }
2832
2833 /* like event_binding, but specify a keymap to search */
2834
2835 Lisp_Object
2836 event_binding_in(Lisp_Object event0, Lisp_Object keymap, int accept_default)
2837 {
2838         /* This function can GC */
2839         if (!KEYMAPP(keymap))
2840                 return Qnil;
2841
2842         return process_event_binding_result(lookup_events(event0, 1, &keymap,
2843                                                           accept_default));
2844 }
2845
2846 /* Attempts to find a function key mapping corresponding to the
2847    event-sequence whose head is event0 (sequence is threaded through
2848    event_next).  The return value will be the same as for event_binding(). */
2849 Lisp_Object
2850 munging_key_map_event_binding(Lisp_Object event0,
2851                               enum munge_me_out_the_door munge)
2852 {
2853         Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2854             CONSOLE_FUNCTION_KEY_MAP(event_console_or_selected(event0)) :
2855             Vkey_translation_map;
2856
2857         if (NILP(keymap))
2858                 return Qnil;
2859
2860         return
2861             process_event_binding_result(lookup_events(event0, 1, &keymap, 1));
2862 }
2863 \f
2864 /************************************************************************/
2865 /*               Setting/querying the global and local maps             */
2866 /************************************************************************/
2867
2868 DEFUN("use-global-map", Fuse_global_map, 1, 1, 0,       /*
2869 Select KEYMAP as the global keymap.
2870 */
2871       (keymap))
2872 {
2873         /* This function can GC */
2874         keymap = get_keymap(keymap, 1, 1);
2875         Vcurrent_global_map = keymap;
2876         return Qnil;
2877 }
2878
2879 DEFUN("use-local-map", Fuse_local_map, 1, 2, 0, /*
2880 Select KEYMAP as the local keymap in BUFFER.
2881 If KEYMAP is nil, that means no local keymap.
2882 If BUFFER is nil, the current buffer is assumed.
2883 */
2884       (keymap, buffer))
2885 {
2886         /* This function can GC */
2887         struct buffer *b = decode_buffer(buffer, 0);
2888         if (!NILP(keymap))
2889                 keymap = get_keymap(keymap, 1, 1);
2890
2891         b->keymap = keymap;
2892
2893         return Qnil;
2894 }
2895
2896 DEFUN("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2897 Return BUFFER's local keymap, or nil if it has none.
2898 If BUFFER is nil, the current buffer is assumed.
2899 */
2900       (buffer))
2901 {
2902         struct buffer *b = decode_buffer(buffer, 0);
2903         return b->keymap;
2904 }
2905
2906 DEFUN("current-global-map", Fcurrent_global_map, 0, 0, 0,       /*
2907 Return the current global keymap.
2908 */
2909       ())
2910 {
2911         return Vcurrent_global_map;
2912 }
2913 \f
2914 /************************************************************************/
2915 /*                    Mapping over keymap elements                      */
2916 /************************************************************************/
2917
2918 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2919    prefix key, it's not entirely obvious what map-keymap should do, but
2920    what it does is: map over all keys in this map; then recursively map
2921    over all submaps of this map that are "bucky" submaps.  This means that,
2922    when mapping over a keymap, it appears that "x" and "C-x" are in the
2923    same map, although "C-x" is really in the "control" submap of this one.
2924    However, since we don't recursively descend the submaps that are bound
2925    to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2926    those explicitly, if that's what they want.
2927
2928    So the end result of this is that the bucky keymaps (the ones indexed
2929    under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2930    invisible from elisp.  They're just an implementation detail that code
2931    outside of this file doesn't need to know about.
2932  */
2933
2934 struct map_keymap_unsorted_closure {
2935         void (*fn) (const struct key_data *, Lisp_Object binding, void *arg);
2936         void *arg;
2937         int modifiers;
2938 };
2939
2940 /* used by map_keymap() */
2941 static int
2942 map_keymap_unsorted_mapper(Lisp_Object keysym, Lisp_Object value,
2943                            void *map_keymap_unsorted_closure)
2944 {
2945         /* This function can GC */
2946         struct map_keymap_unsorted_closure *closure =
2947             (struct map_keymap_unsorted_closure *)map_keymap_unsorted_closure;
2948         int modifiers = closure->modifiers;
2949         int mod_bit;
2950         mod_bit = MODIFIER_HASH_KEY_BITS(keysym);
2951         if (mod_bit != 0) {
2952                 int omod = modifiers;
2953                 closure->modifiers = (modifiers | mod_bit);
2954                 value = get_keymap(value, 1, 0);
2955                 elisp_maphash(map_keymap_unsorted_mapper,
2956                               XKEYMAP(value)->table,
2957                               map_keymap_unsorted_closure);
2958                 closure->modifiers = omod;
2959         } else {
2960                 struct key_data key;
2961                 key.keysym = keysym;
2962                 key.modifiers = modifiers;
2963                 ((*closure->fn) (&key, value, closure->arg));
2964         }
2965         return 0;
2966 }
2967
2968 struct map_keymap_sorted_closure {
2969         Lisp_Object *result_locative;
2970 };
2971
2972 /* used by map_keymap_sorted() */
2973 static int
2974 map_keymap_sorted_mapper(Lisp_Object key, Lisp_Object value,
2975                          void *map_keymap_sorted_closure)
2976 {
2977         struct map_keymap_sorted_closure *cl =
2978                 (struct map_keymap_sorted_closure *)map_keymap_sorted_closure;
2979         Lisp_Object *list = cl->result_locative;
2980         *list = Fcons(Fcons(key, value), *list);
2981         return 0;
2982 }
2983
2984 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2985    and keymap_submaps().
2986  */
2987 static int
2988 map_keymap_sort_predicate(Lisp_Object obj1, Lisp_Object obj2, Lisp_Object pred)
2989 {
2990         /* obj1 and obj2 are conses with keysyms in their cars.  Cdrs are ignored.
2991          */
2992         int bit1, bit2;
2993         int sym1_p = 0;
2994         int sym2_p = 0;
2995         obj1 = XCAR(obj1);
2996         obj2 = XCAR(obj2);
2997
2998         if (EQ(obj1, obj2))
2999                 return -1;
3000         bit1 = MODIFIER_HASH_KEY_BITS(obj1);
3001         bit2 = MODIFIER_HASH_KEY_BITS(obj2);
3002
3003         /* If either is a symbol with a character-set-property, then sort it by
3004            that code instead of alphabetically.
3005          */
3006         if (!bit1 && SYMBOLP(obj1)) {
3007                 Lisp_Object code = Fget(obj1, Vcharacter_set_property, Qnil);
3008                 if (CHAR_OR_CHAR_INTP(code)) {
3009                         obj1 = code;
3010                         CHECK_CHAR_COERCE_INT(obj1);
3011                         sym1_p = 1;
3012                 }
3013         }
3014         if (!bit2 && SYMBOLP(obj2)) {
3015                 Lisp_Object code = Fget(obj2, Vcharacter_set_property, Qnil);
3016                 if (CHAR_OR_CHAR_INTP(code)) {
3017                         obj2 = code;
3018                         CHECK_CHAR_COERCE_INT(obj2);
3019                         sym2_p = 1;
3020                 }
3021         }
3022
3023         /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
3024         if (XTYPE(obj1) != XTYPE(obj2))
3025                 return SYMBOLP(obj2) ? 1 : -1;
3026
3027         if (!bit1 && CHARP(obj1)) {     /* they're both ASCII */
3028                 int o1 = XCHAR(obj1);
3029                 int o2 = XCHAR(obj2);
3030                 if (o1 == o2 && /* If one started out as a symbol and the */
3031                     sym1_p != sym2_p)   /* other didn't, the symbol comes last. */
3032                         return sym2_p ? 1 : -1;
3033
3034                 return o1 < o2 ? 1 : -1;        /* else just compare them */
3035         }
3036
3037         /* else they're both symbols.  If they're both buckys, then order them. */
3038         if (bit1 && bit2)
3039                 return bit1 < bit2 ? 1 : -1;
3040
3041         /* if only one is a bucky, then it comes later */
3042         if (bit1 || bit2)
3043                 return bit2 ? 1 : -1;
3044
3045         /* otherwise, string-sort them. */
3046         {
3047                 char *s1 = (char *)string_data(XSYMBOL(obj1)->name);
3048                 char *s2 = (char *)string_data(XSYMBOL(obj2)->name);
3049 #ifdef I18N2
3050                 return 0 > strcoll(s1, s2) ? 1 : -1;
3051 #else
3052                 return 0 > strcmp(s1, s2) ? 1 : -1;
3053 #endif
3054         }
3055 }
3056
3057 /* used by map_keymap() */
3058 static void
3059 map_keymap_sorted(Lisp_Object keymap_table,
3060                   int modifiers,
3061                   void (*function) (const struct key_data * key,
3062                                     Lisp_Object binding,
3063                                     void *map_keymap_sorted_closure),
3064                   void *map_keymap_sorted_closure)
3065 {
3066         /* This function can GC */
3067         struct gcpro gcpro1;
3068         Lisp_Object contents = Qnil;
3069
3070         if (XINT(Fhash_table_count(keymap_table)) == 0)
3071                 return;
3072
3073         GCPRO1(contents);
3074
3075         {
3076                 struct map_keymap_sorted_closure c1;
3077                 c1.result_locative = &contents;
3078                 elisp_maphash(map_keymap_sorted_mapper, keymap_table, &c1);
3079         }
3080         contents = list_sort(contents, Qnil, map_keymap_sort_predicate);
3081         for (; !NILP(contents); contents = XCDR(contents)) {
3082                 Lisp_Object keysym = XCAR(XCAR(contents));
3083                 Lisp_Object binding = XCDR(XCAR(contents));
3084                 int sub_bits = MODIFIER_HASH_KEY_BITS(keysym);
3085                 if (sub_bits != 0) {
3086                         Lisp_Object tmp = get_keymap(binding, 1, 1);
3087                         map_keymap_sorted(XKEYMAP(tmp)->table,
3088                                           (modifiers | sub_bits),
3089                                           function, map_keymap_sorted_closure);
3090                 } else {
3091                         struct key_data k;
3092                         k.keysym = keysym;
3093                         k.modifiers = modifiers;
3094                         ((*function) (&k, binding, map_keymap_sorted_closure));
3095                 }
3096         }
3097         UNGCPRO;
3098 }
3099
3100 /* used by Fmap_keymap() */
3101 static void
3102 map_keymap_mapper(const struct key_data *key,
3103                   Lisp_Object binding, void *function)
3104 {
3105         /* This function can GC */
3106         Lisp_Object fn;
3107         VOID_TO_LISP(fn, function);
3108         call2(fn, make_key_description(key, 1), binding);
3109 }
3110
3111 static void
3112 map_keymap(Lisp_Object keymap_table, int sort_first,
3113            void (*function) (const struct key_data * key,
3114                              Lisp_Object binding, void *fn_arg), void *fn_arg)
3115 {
3116         /* This function can GC */
3117         if (sort_first)
3118                 map_keymap_sorted(keymap_table, 0, function, fn_arg);
3119         else {
3120                 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
3121                 map_keymap_unsorted_closure.fn = function;
3122                 map_keymap_unsorted_closure.arg = fn_arg;
3123                 map_keymap_unsorted_closure.modifiers = 0;
3124                 elisp_maphash(map_keymap_unsorted_mapper, keymap_table,
3125                               &map_keymap_unsorted_closure);
3126         }
3127 }
3128
3129 DEFUN("map-keymap", Fmap_keymap, 2, 3, 0,       /*
3130 Apply FUNCTION to each element of KEYMAP.
3131 FUNCTION will be called with two arguments: a key-description list, and
3132 the binding.  The order in which the elements of the keymap are passed to
3133 the function is unspecified.  If the function inserts new elements into
3134 the keymap, it may or may not be called with them later.  No element of
3135 the keymap will ever be passed to the function more than once.
3136
3137 The function will not be called on elements of this keymap's parents
3138 \(see the function `keymap-parents') or upon keymaps which are contained
3139 within this keymap (multi-character definitions).
3140 It will be called on "meta" characters since they are not really
3141 two-character sequences.
3142
3143 If the optional third argument SORT-FIRST is non-nil, then the elements of
3144 the keymap will be passed to the mapper function in a canonical order.
3145 Otherwise, they will be passed in hash (that is, random) order, which is
3146 faster.
3147 */
3148       (function, keymap, sort_first))
3149 {
3150         /* This function can GC */
3151         struct gcpro gcpro1, gcpro2, gcpro3;
3152         Lisp_Object table = Qnil;
3153
3154         /* tolerate obviously transposed args */
3155         if (!NILP(Fkeymapp(function))) {
3156                 Lisp_Object tmp = function;
3157                 function = keymap;
3158                 keymap = tmp;
3159         }
3160
3161         GCPRO3(function, keymap, table);
3162         keymap = get_keymap(keymap, 1, 1);
3163
3164         /* elisp_maphash does not allow mapping functions to modify the hash
3165            table being mapped over.  Since map-keymap explicitly allows a
3166            mapping function to modify KEYMAP, we map over a copy of the hash
3167            table instead.  */
3168         table = Fcopy_hash_table(XKEYMAP(keymap)->table);
3169
3170         map_keymap(table, !NILP(sort_first),
3171                    map_keymap_mapper, LISP_TO_VOID(function));
3172         UNGCPRO;
3173         return Qnil;
3174 }
3175 \f
3176 /************************************************************************/
3177 /*                          Accessible keymaps                          */
3178 /************************************************************************/
3179
3180 struct accessible_keymaps_closure {
3181         Lisp_Object tail;
3182 };
3183
3184 static void
3185 accessible_keymaps_mapper_1(Lisp_Object keysym, Lisp_Object contents,
3186                             int modifiers,
3187                             const struct accessible_keymaps_closure *closure)
3188 {
3189         /* This function can GC */
3190         int subbits = MODIFIER_HASH_KEY_BITS(keysym);
3191
3192         if (subbits != 0) {
3193                 Lisp_Object submaps;
3194
3195                 contents = get_keymap(contents, 1, 1);
3196                 submaps = keymap_submaps(contents);
3197                 for (; !NILP(submaps); submaps = XCDR(submaps)) {
3198                         accessible_keymaps_mapper_1(XCAR(XCAR(submaps)),
3199                                                     XCDR(XCAR(submaps)),
3200                                                     (subbits | modifiers),
3201                                                     closure);
3202                 }
3203         } else {
3204                 Lisp_Object thisseq = Fcar(Fcar(closure->tail));
3205                 Lisp_Object cmd = get_keyelt(contents, 1);
3206                 Lisp_Object vec;
3207                 int j;
3208                 int len;
3209                 struct key_data key;
3210                 key.keysym = keysym;
3211                 key.modifiers = modifiers;
3212
3213                 if (NILP(cmd))
3214                         abort();
3215                 cmd = get_keymap(cmd, 0, 1);
3216                 if (!KEYMAPP(cmd))
3217                         abort();
3218
3219                 vec = make_vector(XVECTOR_LENGTH(thisseq) + 1, Qnil);
3220                 len = XVECTOR_LENGTH(thisseq);
3221                 for (j = 0; j < len; j++)
3222                         XVECTOR_DATA(vec)[j] = XVECTOR_DATA(thisseq)[j];
3223                 XVECTOR_DATA(vec)[j] = make_key_description(&key, 1);
3224
3225                 nconc2(closure->tail, list1(Fcons(vec, cmd)));
3226         }
3227 }
3228
3229 static Lisp_Object
3230 accessible_keymaps_keymap_mapper(Lisp_Object thismap, void *arg)
3231 {
3232         /* This function can GC */
3233         const struct accessible_keymaps_closure *closure =
3234                 (const struct accessible_keymaps_closure*)arg;
3235         Lisp_Object submaps = keymap_submaps(thismap);
3236
3237         for (; !NILP(submaps); submaps = XCDR(submaps)) {
3238                 accessible_keymaps_mapper_1(XCAR(XCAR(submaps)),
3239                                             XCDR(XCAR(submaps)), 0, closure);
3240         }
3241         return Qnil;
3242 }
3243
3244 DEFUN("accessible-keymaps", Faccessible_keymaps, 1, 2, 0,       /*
3245 Find all keymaps accessible via prefix characters from KEYMAP.
3246 Returns a list of elements of the form (KEYS . MAP), where the sequence
3247 KEYS starting from KEYMAP gets you to MAP.  These elements are ordered
3248 so that the KEYS increase in length.  The first element is ([] . KEYMAP).
3249 An optional argument PREFIX, if non-nil, should be a key sequence;
3250 then the value includes only maps for prefixes that start with PREFIX.
3251 */
3252       (keymap, prefix))
3253 {
3254         /* This function can GC */
3255         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3256         Lisp_Object accessible_keymaps = Qnil;
3257         struct accessible_keymaps_closure c;
3258         c.tail = Qnil;
3259         GCPRO4(accessible_keymaps, c.tail, prefix, keymap);
3260
3261         keymap = get_keymap(keymap, 1, 1);
3262
3263       retry:
3264         if (NILP(prefix)) {
3265                 prefix = make_vector(0, Qnil);
3266         } else if (VECTORP(prefix) || STRINGP(prefix)) {
3267                 int len = XINT(Flength(prefix));
3268                 Lisp_Object def;
3269                 Lisp_Object p;
3270                 int iii;
3271                 struct gcpro ngcpro1;
3272
3273                 if (len == 0) {
3274                         prefix = Qnil;
3275                         goto retry;
3276                 }
3277
3278                 def = Flookup_key(keymap, prefix, Qnil);
3279                 def = get_keymap(def, 0, 1);
3280                 if (!KEYMAPP(def))
3281                         goto RETURN;
3282
3283                 keymap = def;
3284                 p = make_vector(len, Qnil);
3285                 NGCPRO1(p);
3286                 for (iii = 0; iii < len; iii++) {
3287                         struct key_data key;
3288                         define_key_parser(Faref(prefix, make_int(iii)), &key);
3289                         XVECTOR_DATA(p)[iii] = make_key_description(&key, 1);
3290                 }
3291                 NUNGCPRO;
3292                 prefix = p;
3293         } else {
3294                 prefix = wrong_type_argument(Qarrayp, prefix);
3295                 goto retry;
3296         }
3297
3298         accessible_keymaps = list1(Fcons(prefix, keymap));
3299
3300         /* For each map in the list maps, look at any other maps it points
3301            to and stick them at the end if they are not already in the list */
3302
3303         for (c.tail = accessible_keymaps; !NILP(c.tail); c.tail = XCDR(c.tail)) {
3304                 Lisp_Object thismap = Fcdr(Fcar(c.tail));
3305                 CHECK_KEYMAP(thismap);
3306                 traverse_keymaps(thismap, Qnil,
3307                                  accessible_keymaps_keymap_mapper, &c);
3308         }
3309 RETURN:
3310         UNGCPRO;
3311         return accessible_keymaps;
3312 }
3313 \f
3314 /************************************************************************/
3315 /*              Pretty descriptions of key sequences                    */
3316 /************************************************************************/
3317
3318 DEFUN("key-description", Fkey_description, 1, 1, 0,     /*
3319 Return a pretty description of key-sequence KEYS.
3320 Control characters turn into "C-foo" sequences, meta into "M-foo",
3321 spaces are put between sequence elements, etc...
3322 */
3323       (keys))
3324 {
3325         if (CHAR_OR_CHAR_INTP(keys) || CONSP(keys) || SYMBOLP(keys)
3326             || EVENTP(keys)) {
3327                 return Fsingle_key_description(keys);
3328         } else if (VECTORP(keys) || STRINGP(keys)) {
3329                 Lisp_Object string = Qnil;
3330                 /* Lisp_Object sep = Qnil; */
3331                 int size = XINT(Flength(keys));
3332                 int i;
3333
3334                 for (i = 0; i < size; i++) {
3335                         Lisp_Object s2 = Fsingle_key_description(STRINGP(keys)
3336                                                                  ?
3337                                                                  make_char
3338                                                                  (string_char
3339                                                                   (XSTRING
3340                                                                    (keys), i))
3341                                                                  :
3342                                                                  XVECTOR_DATA
3343                                                                  (keys)[i]);
3344
3345                         if (i == 0)
3346                                 string = s2;
3347                         else {
3348                                 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */
3349                                     ;
3350                                 string =
3351                                     concat2(string,
3352                                             concat2(Vsingle_space_string, s2));
3353                         }
3354                 }
3355                 return string;
3356         }
3357         return Fkey_description(wrong_type_argument(Qsequencep, keys));
3358 }
3359
3360 DEFUN("single-key-description", Fsingle_key_description, 1, 1, 0,       /*
3361 Return a pretty description of command character KEY.
3362 Control characters turn into C-whatever, etc.
3363 This differs from `text-char-description' in that it returns a description
3364 of a key read from the user rather than a character from a buffer.
3365 */
3366       (key))
3367 {
3368         if (SYMBOLP(key))
3369                 key = Fcons(key, Qnil); /* sleaze sleaze */
3370
3371         if (EVENTP(key) || CHAR_OR_CHAR_INTP(key)) {
3372                 char buf[255];
3373                 if (!EVENTP(key)) {
3374                         Lisp_Event event;
3375                         event.event_type = empty_event;
3376                         CHECK_CHAR_COERCE_INT(key);
3377                         character_to_event(XCHAR(key), &event,
3378                                            XCONSOLE(Vselected_console), 0, 1);
3379                         format_event_object(buf, &event, 1);
3380                 } else
3381                         format_event_object(buf, XEVENT(key), 1);
3382                 return build_string(buf);
3383         }
3384
3385         if (CONSP(key)) {
3386                 char buf[255];
3387                 char *bufp = buf;
3388                 Lisp_Object rest;
3389                 buf[sizeof(buf)-1] = buf[0] = '\0';
3390                
3391                 LIST_LOOP(rest, key) {
3392                         Lisp_Object keysym = XCAR(rest);
3393                         if (EQ(keysym, Qcontrol))
3394                                 strcpy(bufp, "C-"), bufp += 2;
3395                         else if (EQ(keysym, Qctrl))
3396                                 strcpy(bufp, "C-"), bufp += 2;
3397                         else if (EQ(keysym, Qmeta))
3398                                 strcpy(bufp, "M-"), bufp += 2;
3399                         else if (EQ(keysym, Qsuper))
3400                                 strcpy(bufp, "S-"), bufp += 2;
3401                         else if (EQ(keysym, Qhyper))
3402                                 strcpy(bufp, "H-"), bufp += 2;
3403                         else if (EQ(keysym, Qalt))
3404                                 strcpy(bufp, "A-"), bufp += 2;
3405                         else if (EQ(keysym, Qshift))
3406                                 strcpy(bufp, "Sh-"), bufp += 3;
3407                         else if (CHAR_OR_CHAR_INTP(keysym)) {
3408                                 bufp += set_charptr_emchar((Bufbyte *) bufp,
3409                                                            XCHAR_OR_CHAR_INT
3410                                                            (keysym));
3411                                 *bufp = 0;
3412                         } else {
3413                                 CHECK_SYMBOL(keysym);
3414 #if 0                           /* This is bogus */
3415                                 if (EQ(keysym, QKlinefeed))
3416                                         strcpy(bufp, "LFD");
3417                                 else if (EQ(keysym, QKtab))
3418                                         strcpy(bufp, "TAB");
3419                                 else if (EQ(keysym, QKreturn))
3420                                         strcpy(bufp, "RET");
3421                                 else if (EQ(keysym, QKescape))
3422                                         strcpy(bufp, "ESC");
3423                                 else if (EQ(keysym, QKdelete))
3424                                         strcpy(bufp, "DEL");
3425                                 else if (EQ(keysym, QKspace))
3426                                         strcpy(bufp, "SPC");
3427                                 else if (EQ(keysym, QKbackspace))
3428                                         strcpy(bufp, "BS");
3429                                 else
3430 #endif
3431                                 {
3432                                         strncpy(bufp,
3433                                                 (char *)
3434                                                 string_data(XSYMBOL(keysym)->
3435                                                             name),
3436                                                 sizeof(buf)-(bufp-buf)-1);
3437                                         /* bufp iterates over buf */
3438                                         buf[sizeof(buf)-1]='\0'; 
3439                                 }
3440                                 if (!NILP(XCDR(rest)))
3441                                         signal_simple_error
3442                                             ("Invalid key description", key);
3443                         }
3444                 }
3445                 return build_string(buf);
3446         }
3447         return Fsingle_key_description
3448             (wrong_type_argument(intern("char-or-event-p"), key));
3449 }
3450
3451 DEFUN("text-char-description", Ftext_char_description, 1, 1, 0, /*
3452 Return a pretty description of file-character CHR.
3453 Unprintable characters turn into "^char" or \\NNN, depending on the value
3454 of the `ctl-arrow' variable.
3455 This differs from `single-key-description' in that it returns a description
3456 of a character from a buffer rather than a key read from the user.
3457 */
3458       (chr))
3459 {
3460         Bufbyte buf[200];
3461         Bufbyte *p;
3462         Emchar c;
3463         Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3464         int ctl_p = !NILP(ctl_arrow);
3465         Emchar printable_min = (CHAR_OR_CHAR_INTP(ctl_arrow)
3466                                 ? XCHAR_OR_CHAR_INT(ctl_arrow)
3467                                 : ((EQ(ctl_arrow, Qt) || NILP(ctl_arrow))
3468                                    ? 256 : 160));
3469
3470         if (EVENTP(chr)) {
3471                 Lisp_Object ch = Fevent_to_character(chr, Qnil, Qnil, Qt);
3472                 if (NILP(ch))
3473                         return
3474                             signal_simple_continuable_error
3475                             ("character has no ASCII equivalent",
3476                              Fcopy_event(chr, Qnil));
3477                 chr = ch;
3478         }
3479
3480         CHECK_CHAR_COERCE_INT(chr);
3481
3482         c = XCHAR(chr);
3483         p = buf;
3484
3485         if (c >= printable_min) {
3486                 p += set_charptr_emchar(p, c);
3487         } else if (c < 040 && ctl_p) {
3488                 *p++ = '^';
3489                 *p++ = c + 64;  /* 'A' - 1 */
3490         } else if (c == 0177) {
3491                 *p++ = '^';
3492                 *p++ = '?';
3493         } else if (c >= 0200 || c < 040) {
3494                 *p++ = '\\';
3495 #ifdef MULE
3496                 /* !!#### This syntax is not readable.  It will
3497                    be interpreted as a 3-digit octal number rather
3498                    than a 7-digit octal number. */
3499                 if (c >= 0400) {
3500                         *p++ = '0' + ((c & 07000000) >> 18);
3501                         *p++ = '0' + ((c & 0700000) >> 15);
3502                         *p++ = '0' + ((c & 070000) >> 12);
3503                         *p++ = '0' + ((c & 07000) >> 9);
3504                 }
3505 #endif
3506                 *p++ = '0' + ((c & 0700) >> 6);
3507                 *p++ = '0' + ((c & 0070) >> 3);
3508                 *p++ = '0' + ((c & 0007));
3509         } else {
3510                 p += set_charptr_emchar(p, c);
3511         }
3512
3513         *p = 0;
3514         return build_string((char *)buf);
3515 }
3516 \f
3517 /************************************************************************/
3518 /*              where-is (mapping bindings to keys)                     */
3519 /************************************************************************/
3520
3521 static Lisp_Object
3522 where_is_internal(Lisp_Object definition, Lisp_Object * maps, int nmaps,
3523                   Lisp_Object firstonly, char *target_buffer);
3524
3525 DEFUN("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3526 Return list of keys that invoke DEFINITION in KEYMAPS.
3527 KEYMAPS can be either a keymap (meaning search in that keymap and the
3528 current global keymap) or a list of keymaps (meaning search in exactly
3529 those keymaps and no others).  If KEYMAPS is nil, search in the currently
3530 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3531 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3532
3533 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3534 the first key sequence found, rather than a list of all possible key
3535 sequences.
3536
3537 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3538 to other keymaps or slots.  This makes it possible to search for an
3539 indirect definition itself.
3540 */
3541       (definition, keymaps, firstonly, noindirect, event_or_keys))
3542 {
3543         /* This function can GC */
3544         Lisp_Object maps[100];
3545         Lisp_Object *gubbish = maps;
3546         int nmaps;
3547
3548         /* Get keymaps as an array */
3549         if (NILP(keymaps)) {
3550                 nmaps = get_relevant_keymaps(event_or_keys, countof(maps),
3551                                              gubbish);
3552                 if (nmaps > countof(maps)) {
3553                         gubbish = alloca_array(Lisp_Object, nmaps);
3554                         nmaps =
3555                             get_relevant_keymaps(event_or_keys, nmaps, gubbish);
3556                 }
3557         } else if (CONSP(keymaps)) {
3558                 Lisp_Object rest;
3559                 int i;
3560
3561                 nmaps = XINT(Flength(keymaps));
3562                 if (nmaps > countof(maps)) {
3563                         gubbish = alloca_array(Lisp_Object, nmaps);
3564                 }
3565                 for (rest = keymaps, i = 0; !NILP(rest);
3566                      rest = XCDR(keymaps), i++) {
3567                         gubbish[i] = get_keymap(XCAR(keymaps), 1, 1);
3568                 }
3569         } else {
3570                 nmaps = 1;
3571                 gubbish[0] = get_keymap(keymaps, 1, 1);
3572                 if (!EQ(gubbish[0], Vcurrent_global_map)) {
3573                         gubbish[1] = Vcurrent_global_map;
3574                         nmaps++;
3575                 }
3576         }
3577
3578         return where_is_internal(definition, gubbish, nmaps, firstonly, 0);
3579 }
3580
3581 /* This function is like
3582    (key-description (where-is-internal definition nil t))
3583    except that it writes its output into a (char *) buffer that you
3584    provide; it doesn't cons (or allocate memory) at all, so it's
3585    very fast.  This is used by menubar.c.
3586  */
3587 void where_is_to_char(Lisp_Object definition, char *buffer)
3588 {
3589         /* This function can GC */
3590         Lisp_Object maps[100];
3591         Lisp_Object *gubbish = maps;
3592         int nmaps;
3593
3594         /* Get keymaps as an array */
3595         nmaps = get_relevant_keymaps(Qnil, countof(maps), gubbish);
3596         if (nmaps > countof(maps)) {
3597                 gubbish = alloca_array(Lisp_Object, nmaps);
3598                 nmaps = get_relevant_keymaps(Qnil, nmaps, gubbish);
3599         }
3600
3601         buffer[0] = 0;
3602         where_is_internal(definition, maps, nmaps, Qt, buffer);
3603 }
3604
3605 static Lisp_Object raw_keys_to_keys(struct key_data *keys, int count)
3606 {
3607         Lisp_Object result = make_vector(count, Qnil);
3608         while (count--)
3609                 XVECTOR_DATA(result)[count] =
3610                     make_key_description(&(keys[count]), 1);
3611         return result;
3612 }
3613
3614 static void format_raw_keys(struct key_data *keys, int count, char *buf)
3615 {
3616         int i;
3617         Lisp_Event event;
3618         event.event_type = key_press_event;
3619         event.channel = Vselected_console;
3620         for (i = 0; i < count; i++) {
3621                 event.event.key.keysym = keys[i].keysym;
3622                 event.event.key.modifiers = keys[i].modifiers;
3623                 format_event_object(buf, &event, 1);
3624                 buf += strlen(buf);
3625                 if (i < count - 1)
3626                         buf[0] = ' ', buf++;
3627         }
3628 }
3629
3630 /* definition is the thing to look for.
3631    map is a keymap.
3632    shadow is an array of shadow_count keymaps; if there is a different
3633    binding in any of the keymaps of a key that we are considering
3634    returning, then we reconsider.
3635    firstonly means give up after finding the first match;
3636    keys_so_far and modifiers_so_far describe which map we're looking in;
3637    If we're in the "meta" submap of the map that "C-x 4" is bound to,
3638    then keys_so_far will be {(control x), \4}, and modifiers_so_far
3639    will be XEMACS_MOD_META.  That is, keys_so_far is the chain of keys that we
3640    have followed, and modifiers_so_far_so_far is the bits (partial keys)
3641    beyond that.
3642
3643    (keys_so_far is a global buffer and the keys_count arg says how much
3644    of it we're currently interested in.)
3645
3646    If target_buffer is provided, then we write a key-description into it,
3647    to avoid consing a string.  This only works with firstonly on.
3648    */
3649
3650 struct where_is_closure {
3651         Lisp_Object definition;
3652         Lisp_Object *shadow;
3653         int shadow_count;
3654         int firstonly;
3655         int keys_count;
3656         int modifiers_so_far;
3657         char *target_buffer;
3658         struct key_data *keys_so_far;
3659         int keys_so_far_total_size;
3660         int keys_so_far_malloced;
3661 };
3662
3663 /* arg is modified, so cannot be const */
3664 static Lisp_Object where_is_recursive_mapper(Lisp_Object map, void *arg);
3665
3666 static Lisp_Object where_is_recursive_mapper(Lisp_Object map, void *arg)
3667 {
3668         /* This function can GC */
3669         /* inevitable warning, we must modify c */
3670         struct where_is_closure *c = (struct where_is_closure *)arg;
3671         Lisp_Object definition = c->definition;
3672         const int firstonly = c->firstonly;
3673         const int keys_count = c->keys_count;
3674         const int modifiers_so_far = c->modifiers_so_far;
3675         char *target_buffer = c->target_buffer;
3676         Lisp_Object keys = Fgethash(definition,
3677                                     XKEYMAP(map)->inverse_table,
3678                                     Qnil);
3679         Lisp_Object submaps;
3680         Lisp_Object result = Qnil;
3681
3682         if (!NILP(keys)) {
3683                 /* One or more keys in this map match the definition we're looking for.
3684                    Verify that these bindings aren't shadowed by other bindings
3685                    in the shadow maps.  Either nil or number as value from
3686                    raw_lookup_key() means undefined.  */
3687                 struct key_data *so_far = c->keys_so_far;
3688
3689                 for (;;) {      /* loop over all keys that match */
3690                         Lisp_Object k = CONSP(keys) ? XCAR(keys) : keys;
3691                         int i;
3692
3693                         so_far[keys_count].keysym = k;
3694                         so_far[keys_count].modifiers = modifiers_so_far;
3695
3696                         /* now loop over all shadow maps */
3697                         for (i = 0; i < c->shadow_count; i++) {
3698                                 Lisp_Object shadowed =
3699                                     raw_lookup_key(c->shadow[i],
3700                                                    so_far,
3701                                                    keys_count + 1,
3702                                                    0, 1);
3703
3704                                 if (NILP(shadowed) || CHARP(shadowed) ||
3705                                     EQ(shadowed, definition))
3706                                         continue;       /* we passed this test; it's not shadowed here. */
3707                                 else
3708                                         /* ignore this key binding, since it actually has a
3709                                            different binding in a shadowing map */
3710                                         goto c_doesnt_have_proper_loop_exit_statements;
3711                         }
3712
3713                         /* OK, the key is for real */
3714                         if (target_buffer) {
3715                                 if (!firstonly)
3716                                         abort();
3717                                 format_raw_keys(so_far, keys_count + 1,
3718                                                 target_buffer);
3719                                 return make_int(1);
3720                         } else if (firstonly)
3721                                 return raw_keys_to_keys(so_far, keys_count + 1);
3722                         else
3723                                 result =
3724                                     Fcons(raw_keys_to_keys
3725                                           (so_far, keys_count + 1), result);
3726
3727                       c_doesnt_have_proper_loop_exit_statements:
3728                         /* now on to the next matching key ... */
3729                         if (!CONSP(keys))
3730                                 break;
3731                         keys = XCDR(keys);
3732                 }
3733         }
3734
3735         /* Now search the sub-keymaps of this map.
3736            If we're in "firstonly" mode and have already found one, this
3737            point is not reached.  If we get one from lower down, either
3738            return it immediately (in firstonly mode) or tack it onto the
3739            end of the ones we've gotten so far.
3740          */
3741         for (submaps = keymap_submaps(map);
3742              !NILP(submaps); submaps = XCDR(submaps)) {
3743                 Lisp_Object key = XCAR(XCAR(submaps));
3744                 Lisp_Object submap = XCDR(XCAR(submaps));
3745                 int lower_modifiers;
3746                 int lower_keys_count = keys_count;
3747                 int bucky;
3748
3749                 submap = get_keymap(submap, 0, 0);
3750
3751                 if (EQ(submap, map))
3752                         /* Arrgh!  Some loser has introduced a loop... */
3753                         continue;
3754
3755                 /* If this is not a keymap, then that's probably because someone
3756                    did an `fset' of a symbol that used to point to a map such that
3757                    it no longer does.  Sigh.  Ignore this, and invalidate the cache
3758                    so that it doesn't happen to us next time too.
3759                  */
3760                 if (NILP(submap)) {
3761                         XKEYMAP(map)->sub_maps_cache = Qt;
3762                         continue;
3763                 }
3764
3765                 /* If the map is a "bucky" map, then add a bit to the
3766                    modifiers_so_far list.
3767                    Otherwise, add a new raw_key onto the end of keys_so_far.
3768                  */
3769                 bucky = MODIFIER_HASH_KEY_BITS(key);
3770                 if (bucky != 0)
3771                         lower_modifiers = (modifiers_so_far | bucky);
3772                 else {
3773                         struct key_data *so_far = c->keys_so_far;
3774                         lower_modifiers = 0;
3775                         so_far[lower_keys_count].keysym = key;
3776                         so_far[lower_keys_count].modifiers = modifiers_so_far;
3777                         lower_keys_count++;
3778                 }
3779
3780                 if (lower_keys_count >= c->keys_so_far_total_size) {
3781                         int size = lower_keys_count + 50;
3782                         if (!c->keys_so_far_malloced) {
3783                                 struct key_data *new =
3784                                         xnew_array(struct key_data, size);
3785                                 memcpy((void*)new,
3786                                        (const void*)c->keys_so_far,
3787                                        c->keys_so_far_total_size *
3788                                        sizeof(struct key_data));
3789                                 xfree(c->keys_so_far);
3790                                 c->keys_so_far = new;
3791                         } else
3792                                 XREALLOC_ARRAY(c->keys_so_far, struct key_data,
3793                                                size);
3794
3795                         c->keys_so_far_total_size = size;
3796                         c->keys_so_far_malloced = 1;
3797                 }
3798
3799                 {
3800                         Lisp_Object lower;
3801
3802                         c->keys_count = lower_keys_count;
3803                         c->modifiers_so_far = lower_modifiers;
3804
3805                         lower = traverse_keymaps(
3806                                 submap, Qnil, where_is_recursive_mapper, c);
3807
3808                         c->keys_count = keys_count;
3809                         c->modifiers_so_far = modifiers_so_far;
3810
3811                         if (!firstonly) {
3812                                 result = nconc2(lower, result);
3813                         } else if (!NILP(lower)) {
3814                                 return lower;
3815                         }
3816                 }
3817         }
3818         return result;
3819 }
3820
3821 static Lisp_Object
3822 where_is_internal(Lisp_Object definition, Lisp_Object * maps, int nmaps,
3823                   Lisp_Object firstonly, char *target_buffer)
3824 {
3825         /* This function can GC */
3826         Lisp_Object result = Qnil;
3827         int i;
3828         struct key_data raw[20];
3829         struct where_is_closure c;
3830
3831         c.definition = definition;
3832         c.shadow = maps;
3833         c.firstonly = !NILP(firstonly);
3834         c.target_buffer = target_buffer;
3835         c.keys_so_far = raw;
3836         c.keys_so_far_total_size = countof(raw);
3837         c.keys_so_far_malloced = 0;
3838
3839         /* Loop over each of the maps, accumulating the keys found.
3840            For each map searched, all previous maps shadow this one
3841            so that bogus keys aren't listed. */
3842         for (i = 0; i < nmaps; i++) {
3843                 Lisp_Object this_result;
3844                 c.shadow_count = i;
3845                 /* Reset the things set in each iteration */
3846                 c.keys_count = 0;
3847                 c.modifiers_so_far = 0;
3848
3849                 this_result =
3850                         traverse_keymaps(
3851                                 maps[i], Qnil, where_is_recursive_mapper, &c);
3852                 if (!NILP(firstonly)) {
3853                         result = this_result;
3854                         if (!NILP(result)) {
3855                                 break;
3856                         }
3857                 } else {
3858                         result = nconc2(this_result, result);
3859                 }
3860         }
3861
3862         if (NILP(firstonly)) {
3863                 result = Fnreverse(result);
3864         }
3865         if (c.keys_so_far_malloced) {
3866                 xfree(c.keys_so_far);
3867         }
3868         return result;
3869 }
3870 \f
3871 /************************************************************************/
3872 /*                         Describing keymaps                           */
3873 /************************************************************************/
3874
3875 DEFUN("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0,       /*
3876 Insert a list of all defined keys and their definitions in MAP.
3877 Optional second argument ALL says whether to include even "uninteresting"
3878 definitions (ie symbols with a non-nil `suppress-keymap' property.
3879 Third argument SHADOW is a list of keymaps whose bindings shadow those
3880 of map; if a binding is present in any shadowing map, it is not printed.
3881 Fourth argument PREFIX, if non-nil, should be a key sequence;
3882 only bindings which start with that key sequence will be printed.
3883 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3884 */
3885       (map, all, shadow, prefix, mouse_only_p))
3886 {
3887         /* This function can GC */
3888
3889         /* #### At some point, this function should be changed to accept a
3890            BUFFER argument.  Currently, the BUFFER argument to
3891            describe_map_tree is being used only internally.  */
3892         describe_map_tree(map, NILP(all), shadow, prefix,
3893                           !NILP(mouse_only_p), Fcurrent_buffer());
3894         return Qnil;
3895 }
3896
3897 /* Insert a description of the key bindings in STARTMAP,
3898     followed by those of all maps reachable through STARTMAP.
3899    If PARTIAL is nonzero, omit certain "uninteresting" commands
3900     (such as `undefined').
3901    If SHADOW is non-nil, it is a list of other maps;
3902     don't mention keys which would be shadowed by any of them
3903    If PREFIX is non-nil, only list bindings which start with those keys.
3904  */
3905
3906 void
3907 describe_map_tree(Lisp_Object startmap, int partial, Lisp_Object shadow,
3908                   Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3909 {
3910         /* This function can GC */
3911         Lisp_Object maps = Qnil;
3912         struct gcpro gcpro1, gcpro2;    /* get_keymap may autoload */
3913         GCPRO2(maps, shadow);
3914
3915         maps = Faccessible_keymaps(startmap, prefix);
3916
3917         for (; !NILP(maps); maps = Fcdr(maps)) {
3918                 Lisp_Object sub_shadow = Qnil;
3919                 Lisp_Object elt = Fcar(maps);
3920                 Lisp_Object tail;
3921                 Lisp_Object tmp = Fcar(elt);
3922                 int no_prefix = (VECTORP(tmp) && XINT(Flength(tmp)) == 0);
3923                 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3924                 NGCPRO3(sub_shadow, elt, tail);
3925
3926                 for (tail = shadow; CONSP(tail); tail = XCDR(tail)) {
3927                         Lisp_Object shmap = XCAR(tail);
3928
3929                         /* If the sequence by which we reach this keymap is zero-length,
3930                            then the shadow maps for this keymap are just SHADOW.  */
3931                         if (no_prefix) ;
3932                         /* If the sequence by which we reach this keymap actually has
3933                            some elements, then the sequence's definition in SHADOW is
3934                            what we should use.  */
3935                         else {
3936                                 shmap = Flookup_key(shmap, Fcar(elt), Qt);
3937                                 if (CHARP(shmap))
3938                                         shmap = Qnil;
3939                         }
3940
3941                         if (!NILP(shmap)) {
3942                                 Lisp_Object shm = get_keymap(shmap, 0, 1);
3943                                 /* If shmap is not nil and not a keymap, it completely
3944                                    shadows this map, so don't describe this map at all.  */
3945                                 if (!KEYMAPP(shm))
3946                                         goto SKIP;
3947                                 sub_shadow = Fcons(shm, sub_shadow);
3948                         }
3949                 }
3950
3951                 {
3952                         /* Describe the contents of map MAP, assuming that this map
3953                            itself is reached by the sequence of prefix keys KEYS (a vector).
3954                            PARTIAL and SHADOW are as in `describe_map_tree'.  */
3955                         Lisp_Object keysdesc = ((!no_prefix)
3956                                                 ?
3957                                                 concat2(Fkey_description
3958                                                         (Fcar(elt)),
3959                                                         Vsingle_space_string)
3960                                                 : Qnil);
3961                         describe_map(Fcdr(elt), keysdesc,
3962                                      describe_command,
3963                                      partial, sub_shadow, mice_only_p, buffer);
3964                 }
3965               SKIP:
3966                 NUNGCPRO;
3967         }
3968         UNGCPRO;
3969 }
3970
3971 static void describe_command(Lisp_Object definition, Lisp_Object buffer)
3972 {
3973         /* This function can GC */
3974         int keymapp = !NILP(Fkeymapp(definition));
3975         struct gcpro gcpro1;
3976         GCPRO1(definition);
3977
3978         Findent_to(make_int(16), make_int(3), buffer);
3979         if (keymapp)
3980                 buffer_insert_c_string(XBUFFER(buffer), "<< ");
3981
3982         if (SYMBOLP(definition)) {
3983                 buffer_insert1(XBUFFER(buffer), Fsymbol_name(definition));
3984         } else if (STRINGP(definition) || VECTORP(definition)) {
3985                 buffer_insert_c_string(XBUFFER(buffer), "Kbd Macro: ");
3986                 buffer_insert1(XBUFFER(buffer), Fkey_description(definition));
3987         } else if (COMPILED_FUNCTIONP(definition))
3988                 buffer_insert_c_string(XBUFFER(buffer),
3989                                        "Anonymous Compiled Function");
3990         else if (CONSP(definition) && EQ(XCAR(definition), Qlambda))
3991                 buffer_insert_c_string(XBUFFER(buffer), "Anonymous Lambda");
3992         else if (KEYMAPP(definition)) {
3993                 Lisp_Object name = XKEYMAP(definition)->name;
3994                 if (STRINGP(name) || (SYMBOLP(name) && !NILP(name))) {
3995                         buffer_insert_c_string(XBUFFER(buffer),
3996                                                "Prefix command ");
3997                         if (SYMBOLP(name)
3998                             && EQ(find_symbol_value(name), definition))
3999                                 buffer_insert1(XBUFFER(buffer),
4000                                                Fsymbol_name(name));
4001                         else {
4002                                 buffer_insert1(XBUFFER(buffer),
4003                                                Fprin1_to_string(name, Qnil));
4004                         }
4005                 } else
4006                         buffer_insert_c_string(XBUFFER(buffer),
4007                                                "Prefix Command");
4008         } else
4009                 buffer_insert_c_string(XBUFFER(buffer), "??");
4010
4011         if (keymapp)
4012                 buffer_insert_c_string(XBUFFER(buffer), " >>");
4013         buffer_insert_c_string(XBUFFER(buffer), "\n");
4014         UNGCPRO;
4015 }
4016
4017 struct describe_map_closure {
4018         Lisp_Object *list;      /* pointer to the list to update */
4019         Lisp_Object partial;    /* whether to ignore suppressed commands */
4020         Lisp_Object shadow;     /* list of maps shadowing this one */
4021         Lisp_Object self;       /* this map */
4022         Lisp_Object self_root;  /* this map, or some map that has this map as
4023                                    a parent.  this is the base of the tree */
4024         int mice_only_p;        /* whether we are to display only button bindings */
4025 };
4026
4027 struct describe_map_shadow_closure {
4028         const struct key_data *raw_key;
4029         Lisp_Object self;
4030 };
4031
4032 static Lisp_Object
4033 describe_map_mapper_shadow_search(Lisp_Object map, void *arg)
4034 {
4035         const struct describe_map_shadow_closure *c =
4036                 (const struct describe_map_shadow_closure *)arg;
4037
4038         if (EQ(map, c->self)) {
4039                 return Qzero;   /* Not shadowed; terminate search */
4040         }
4041         return !NILP(keymap_lookup_directly(
4042                              map, c->raw_key->keysym, c->raw_key->modifiers))
4043                 ? Qt : Qnil;
4044 }
4045
4046 static Lisp_Object
4047 keymap_lookup_inherited_mapper(Lisp_Object km, void *arg)
4048 {
4049         const struct key_data *k = (const struct key_data *)arg;
4050         return keymap_lookup_directly(km, k->keysym, k->modifiers);
4051 }
4052
4053 static void
4054 describe_map_mapper(struct key_data *key,
4055                     Lisp_Object binding, const void *describe_map_closure)
4056 {
4057         /* This function can GC */
4058         const struct describe_map_closure *closure =
4059                 (const struct describe_map_closure *)describe_map_closure;
4060         Lisp_Object keysym = key->keysym;
4061         int modifiers = key->modifiers;
4062
4063         /* Don't mention suppressed commands.  */
4064         if (SYMBOLP(binding)
4065             && !NILP(closure->partial)
4066             && !NILP(Fget(binding, closure->partial, Qnil)))
4067                 return;
4068
4069         /* If we're only supposed to display mouse bindings and this isn't one,
4070            then bug out. */
4071         if (closure->mice_only_p &&
4072             (!(EQ(keysym, Qbutton0) ||
4073                EQ(keysym, Qbutton1) ||
4074                EQ(keysym, Qbutton2) ||
4075                EQ(keysym, Qbutton3) ||
4076                EQ(keysym, Qbutton4) ||
4077                EQ(keysym, Qbutton5) ||
4078                EQ(keysym, Qbutton6) ||
4079                EQ(keysym, Qbutton7) ||
4080                EQ(keysym, Qbutton8) ||
4081                EQ(keysym, Qbutton9) ||
4082                EQ(keysym, Qbutton10) ||
4083                EQ(keysym, Qbutton11) ||
4084                EQ(keysym, Qbutton12) ||
4085                EQ(keysym, Qbutton13) ||
4086                EQ(keysym, Qbutton14) ||
4087                EQ(keysym, Qbutton15) ||
4088                EQ(keysym, Qbutton16) ||
4089                EQ(keysym, Qbutton17) ||
4090                EQ(keysym, Qbutton18) ||
4091                EQ(keysym, Qbutton19) ||
4092                EQ(keysym, Qbutton20) ||
4093                EQ(keysym, Qbutton21) ||
4094                EQ(keysym, Qbutton22) ||
4095                EQ(keysym, Qbutton23) ||
4096                EQ(keysym, Qbutton24) ||
4097                EQ(keysym, Qbutton25) ||
4098                EQ(keysym, Qbutton26) ||
4099                EQ(keysym, Qbutton27) ||
4100                EQ(keysym, Qbutton28) ||
4101                EQ(keysym, Qbutton29) ||
4102                EQ(keysym, Qbutton30) ||
4103                EQ(keysym, Qbutton31) ||
4104                EQ(keysym, Qbutton32) ||
4105                EQ(keysym, Qbutton0up) ||
4106                EQ(keysym, Qbutton1up) ||
4107                EQ(keysym, Qbutton2up) ||
4108                EQ(keysym, Qbutton3up) ||
4109                EQ(keysym, Qbutton4up) ||
4110                EQ(keysym, Qbutton5up) ||
4111                EQ(keysym, Qbutton6up) ||
4112                EQ(keysym, Qbutton7up) ||
4113                EQ(keysym, Qbutton8up) ||
4114                EQ(keysym, Qbutton9up) ||
4115                EQ(keysym, Qbutton10up) ||
4116                EQ(keysym, Qbutton11up) ||
4117                EQ(keysym, Qbutton12up) ||
4118                EQ(keysym, Qbutton13up) ||
4119                EQ(keysym, Qbutton14up) ||
4120                EQ(keysym, Qbutton15up) ||
4121                EQ(keysym, Qbutton16up) ||
4122                EQ(keysym, Qbutton17up) ||
4123                EQ(keysym, Qbutton18up) ||
4124                EQ(keysym, Qbutton19up) ||
4125                EQ(keysym, Qbutton20up) ||
4126                EQ(keysym, Qbutton21up) ||
4127                EQ(keysym, Qbutton22up) ||
4128                EQ(keysym, Qbutton23up) ||
4129                EQ(keysym, Qbutton24up) ||
4130                EQ(keysym, Qbutton25up) ||
4131                EQ(keysym, Qbutton26up) ||
4132                EQ(keysym, Qbutton27up) ||
4133                EQ(keysym, Qbutton28up) ||
4134                EQ(keysym, Qbutton29up) ||
4135                EQ(keysym, Qbutton30up) ||
4136                EQ(keysym, Qbutton31up) ||
4137                EQ(keysym, Qbutton32up)))) {
4138                 return;
4139         }
4140         /* If this command in this map is shadowed by some other map, ignore
4141            it. */
4142         {
4143                 Lisp_Object tail;
4144
4145                 for (tail = closure->shadow; CONSP(tail); tail = XCDR(tail)) {
4146                         QUIT;
4147                         if (!NILP(traverse_keymaps(
4148                                           XCAR(tail), Qnil,
4149                                           keymap_lookup_inherited_mapper,
4150                                           /* Cast to discard `const' */
4151                                           (void*)key))) {
4152                                 return;
4153                         }
4154                 }
4155         }
4156
4157         /* If this key is in some map of which this map is a parent, then ignore
4158            it (in that case, it has been shadowed).
4159          */
4160         {
4161                 Lisp_Object sh;
4162                 struct describe_map_shadow_closure c;
4163                 c.raw_key = key;
4164                 c.self = closure->self;
4165
4166                 sh = traverse_keymaps(closure->self_root, Qnil,
4167                                       describe_map_mapper_shadow_search, &c);
4168                 if (!NILP(sh) && !ZEROP(sh)) {
4169                         return;
4170                 }
4171         }
4172
4173         /* Otherwise add it to the list to be sorted. */
4174         *(closure->list) = Fcons(Fcons(Fcons(keysym, make_int(modifiers)),
4175                                        binding), *(closure->list));
4176 }
4177
4178 static int
4179 describe_map_sort_predicate(Lisp_Object obj1, Lisp_Object obj2,
4180                             Lisp_Object pred)
4181 {
4182         /* obj1 and obj2 are conses of the form
4183            ( ( <keysym> . <modifiers> ) . <binding> )
4184            keysym and modifiers are used, binding is ignored.
4185          */
4186         int bit1, bit2;
4187         obj1 = XCAR(obj1);
4188         obj2 = XCAR(obj2);
4189         bit1 = XINT(XCDR(obj1));
4190         bit2 = XINT(XCDR(obj2));
4191         if (bit1 != bit2)
4192                 return bit1 < bit2 ? 1 : -1;
4193         else
4194                 return map_keymap_sort_predicate(obj1, obj2, pred);
4195 }
4196
4197 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4198    or 2 or more symbolic keysyms that are bound to the same thing and
4199    have consecutive character-set-properties.
4200  */
4201 static int elide_next_two_p(Lisp_Object list)
4202 {
4203         Lisp_Object s1, s2;
4204
4205         if (NILP(XCDR(list)))
4206                 return 0;
4207
4208         /* next two bindings differ */
4209         if (!EQ(XCDR(XCAR(list)), XCDR(XCAR(XCDR(list)))))
4210                 return 0;
4211
4212         /* next two modifier-sets differ */
4213         if (!EQ(XCDR(XCAR(XCAR(list))), XCDR(XCAR(XCAR(XCDR(list))))))
4214                 return 0;
4215
4216         s1 = XCAR(XCAR(XCAR(list)));
4217         s2 = XCAR(XCAR(XCAR(XCDR(list))));
4218
4219         if (SYMBOLP(s1)) {
4220                 Lisp_Object code = Fget(s1, Vcharacter_set_property, Qnil);
4221                 if (CHAR_OR_CHAR_INTP(code)) {
4222                         s1 = code;
4223                         CHECK_CHAR_COERCE_INT(s1);
4224                 } else
4225                         return 0;
4226         }
4227         if (SYMBOLP(s2)) {
4228                 Lisp_Object code = Fget(s2, Vcharacter_set_property, Qnil);
4229                 if (CHAR_OR_CHAR_INTP(code)) {
4230                         s2 = code;
4231                         CHECK_CHAR_COERCE_INT(s2);
4232                 } else
4233                         return 0;
4234         }
4235
4236         return (XCHAR(s1) == XCHAR(s2) || XCHAR(s1) + 1 == XCHAR(s2));
4237 }
4238
4239 static Lisp_Object
4240 describe_map_parent_mapper(Lisp_Object keymap, void *arg)
4241 {
4242         /* This function can GC */
4243         struct describe_map_closure *describe_map_closure =
4244                 (struct describe_map_closure *)arg;
4245         describe_map_closure->self = keymap;
4246         /* don't sort: we'll do it later */
4247         map_keymap(XKEYMAP(keymap)->table, 0,
4248                    (void(*)(const struct key_data*, Lisp_Object, void*))
4249                    describe_map_mapper, describe_map_closure);
4250         return Qnil;
4251 }
4252
4253 /* Describe the contents of map MAP, assuming that this map itself is
4254    reached by the sequence of prefix keys KEYS (a string or vector).
4255    PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above.  */
4256
4257 static void
4258 describe_map(Lisp_Object keymap, Lisp_Object elt_prefix,
4259              void (*elt_describer) (Lisp_Object, Lisp_Object),
4260              int partial,
4261              Lisp_Object shadow, int mice_only_p, Lisp_Object buffer)
4262 {
4263         /* This function can GC */
4264         struct describe_map_closure describe_map_closure;
4265         Lisp_Object list = Qnil;
4266         struct buffer *buf = XBUFFER(buffer);
4267         Emchar printable_min = (CHAR_OR_CHAR_INTP(buf->ctl_arrow)
4268                                 ? XCHAR_OR_CHAR_INT(buf->ctl_arrow)
4269                                 : ((EQ(buf->ctl_arrow, Qt)
4270                                     || EQ(buf->ctl_arrow, Qnil))
4271                                    ? 256 : 160));
4272         int elided = 0;
4273         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4274
4275         keymap = get_keymap(keymap, 1, 1);
4276         describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4277         describe_map_closure.shadow = shadow;
4278         describe_map_closure.list = &list;
4279         describe_map_closure.self_root = keymap;
4280         describe_map_closure.mice_only_p = mice_only_p;
4281
4282         GCPRO4(keymap, elt_prefix, shadow, list);
4283
4284         traverse_keymaps(keymap, Qnil,
4285                          describe_map_parent_mapper, &describe_map_closure);
4286
4287         if (!NILP(list)) {
4288                 list = list_sort(list, Qnil, describe_map_sort_predicate);
4289                 buffer_insert_c_string(buf, "\n");
4290                 while (!NILP(list)) {
4291                         Lisp_Object elt = XCAR(XCAR(list));
4292                         Lisp_Object keysym = XCAR(elt);
4293                         int modifiers = XINT(XCDR(elt));
4294
4295                         if (!NILP(elt_prefix))
4296                                 buffer_insert_lisp_string(buf, elt_prefix);
4297
4298                         if (modifiers & XEMACS_MOD_META)
4299                                 buffer_insert_c_string(buf, "M-");
4300                         if (modifiers & XEMACS_MOD_CONTROL)
4301                                 buffer_insert_c_string(buf, "C-");
4302                         if (modifiers & XEMACS_MOD_SUPER)
4303                                 buffer_insert_c_string(buf, "S-");
4304                         if (modifiers & XEMACS_MOD_HYPER)
4305                                 buffer_insert_c_string(buf, "H-");
4306                         if (modifiers & XEMACS_MOD_ALT)
4307                                 buffer_insert_c_string(buf, "Alt-");
4308                         if (modifiers & XEMACS_MOD_SHIFT)
4309                                 buffer_insert_c_string(buf, "Sh-");
4310                         if (SYMBOLP(keysym)) {
4311                                 Lisp_Object code =
4312                                     Fget(keysym, Vcharacter_set_property, Qnil);
4313                                 Emchar c = (CHAR_OR_CHAR_INTP(code)
4314                                             ? XCHAR_OR_CHAR_INT(code) : (Emchar)
4315                                             - 1);
4316                                 /* Calling Fsingle_key_description() would cons more */
4317 #if 0                           /* This is bogus */
4318                                 if (EQ(keysym, QKlinefeed))
4319                                         buffer_insert_c_string(buf, "LFD");
4320                                 else if (EQ(keysym, QKtab))
4321                                         buffer_insert_c_string(buf, "TAB");
4322                                 else if (EQ(keysym, QKreturn))
4323                                         buffer_insert_c_string(buf, "RET");
4324                                 else if (EQ(keysym, QKescape))
4325                                         buffer_insert_c_string(buf, "ESC");
4326                                 else if (EQ(keysym, QKdelete))
4327                                         buffer_insert_c_string(buf, "DEL");
4328                                 else if (EQ(keysym, QKspace))
4329                                         buffer_insert_c_string(buf, "SPC");
4330                                 else if (EQ(keysym, QKbackspace))
4331                                         buffer_insert_c_string(buf, "BS");
4332                                 else
4333 #endif
4334                                 if (c >= printable_min)
4335                                         buffer_insert_emacs_char(buf, c);
4336                                 else
4337                                         buffer_insert1(buf,
4338                                                        Fsymbol_name(keysym));
4339                         } else if (CHARP(keysym))
4340                                 buffer_insert_emacs_char(buf, XCHAR(keysym));
4341                         else
4342                                 buffer_insert_c_string(buf, "---bad keysym---");
4343
4344                         if (elided)
4345                                 elided = 0;
4346                         else {
4347                                 int k = 0;
4348
4349                                 while (elide_next_two_p(list)) {
4350                                         k++;
4351                                         list = XCDR(list);
4352                                 }
4353                                 if (k != 0) {
4354                                         if (k == 1)
4355                                                 buffer_insert_c_string(buf,
4356                                                                        ", ");
4357                                         else
4358                                                 buffer_insert_c_string(buf,
4359                                                                        " .. ");
4360                                         elided = 1;
4361                                         continue;
4362                                 }
4363                         }
4364
4365                         /* Print a description of the definition of this character.  */
4366                         (*elt_describer) (XCDR(XCAR(list)), buffer);
4367                         list = XCDR(list);
4368                 }
4369         }
4370         UNGCPRO;
4371 }
4372 \f
4373 void syms_of_keymap(void)
4374 {
4375         INIT_LRECORD_IMPLEMENTATION(keymap);
4376
4377         defsymbol(&Qminor_mode_map_alist, "minor-mode-map-alist");
4378
4379         defsymbol(&Qkeymapp, "keymapp");
4380
4381         defsymbol(&Qsuppress_keymap, "suppress-keymap");
4382
4383         defsymbol(&Qmodeline_map, "modeline-map");
4384         defsymbol(&Qtoolbar_map, "toolbar-map");
4385
4386         DEFSUBR(Fkeymap_parents);
4387         DEFSUBR(Fset_keymap_parents);
4388         DEFSUBR(Fkeymap_name);
4389         DEFSUBR(Fset_keymap_name);
4390         DEFSUBR(Fkeymap_prompt);
4391         DEFSUBR(Fset_keymap_prompt);
4392         DEFSUBR(Fkeymap_default_binding);
4393         DEFSUBR(Fset_keymap_default_binding);
4394
4395         DEFSUBR(Fkeymapp);
4396         DEFSUBR(Fmake_keymap);
4397         DEFSUBR(Fmake_sparse_keymap);
4398
4399         DEFSUBR(Fcopy_keymap);
4400         DEFSUBR(Fkeymap_fullness);
4401         DEFSUBR(Fmap_keymap);
4402         DEFSUBR(Fevent_matches_key_specifier_p);
4403         DEFSUBR(Fdefine_key);
4404         DEFSUBR(Flookup_key);
4405         DEFSUBR(Fkey_binding);
4406         DEFSUBR(Fuse_global_map);
4407         DEFSUBR(Fuse_local_map);
4408         DEFSUBR(Fcurrent_local_map);
4409         DEFSUBR(Fcurrent_global_map);
4410         DEFSUBR(Fcurrent_keymaps);
4411         DEFSUBR(Faccessible_keymaps);
4412         DEFSUBR(Fkey_description);
4413         DEFSUBR(Fsingle_key_description);
4414         DEFSUBR(Fwhere_is_internal);
4415         DEFSUBR(Fdescribe_bindings_internal);
4416
4417         DEFSUBR(Ftext_char_description);
4418
4419         defsymbol(&Qcontrol, "control");
4420         defsymbol(&Qctrl, "ctrl");
4421         defsymbol(&Qmeta, "meta");
4422         defsymbol(&Qsuper, "super");
4423         defsymbol(&Qhyper, "hyper");
4424         defsymbol(&Qalt, "alt");
4425         defsymbol(&Qshift, "shift");
4426         defsymbol(&Qbutton0, "button0");
4427         defsymbol(&Qbutton1, "button1");
4428         defsymbol(&Qbutton2, "button2");
4429         defsymbol(&Qbutton3, "button3");
4430         defsymbol(&Qbutton4, "button4");
4431         defsymbol(&Qbutton5, "button5");
4432         defsymbol(&Qbutton6, "button6");
4433         defsymbol(&Qbutton7, "button7");
4434         defsymbol(&Qbutton8, "button8");
4435         defsymbol(&Qbutton9, "button9");
4436         defsymbol(&Qbutton10, "button10");
4437         defsymbol(&Qbutton11, "button11");
4438         defsymbol(&Qbutton12, "button12");
4439         defsymbol(&Qbutton13, "button13");
4440         defsymbol(&Qbutton14, "button14");
4441         defsymbol(&Qbutton15, "button15");
4442         defsymbol(&Qbutton16, "button16");
4443         defsymbol(&Qbutton17, "button17");
4444         defsymbol(&Qbutton18, "button18");
4445         defsymbol(&Qbutton19, "button19");
4446         defsymbol(&Qbutton20, "button20");
4447         defsymbol(&Qbutton21, "button21");
4448         defsymbol(&Qbutton22, "button22");
4449         defsymbol(&Qbutton23, "button23");
4450         defsymbol(&Qbutton24, "button24");
4451         defsymbol(&Qbutton25, "button25");
4452         defsymbol(&Qbutton26, "button26");
4453         defsymbol(&Qbutton27, "button27");
4454         defsymbol(&Qbutton28, "button28");
4455         defsymbol(&Qbutton29, "button29");
4456         defsymbol(&Qbutton30, "button30");
4457         defsymbol(&Qbutton31, "button31");
4458         defsymbol(&Qbutton32, "button32");
4459         defsymbol(&Qbutton0up, "button0up");
4460         defsymbol(&Qbutton1up, "button1up");
4461         defsymbol(&Qbutton2up, "button2up");
4462         defsymbol(&Qbutton3up, "button3up");
4463         defsymbol(&Qbutton4up, "button4up");
4464         defsymbol(&Qbutton5up, "button5up");
4465         defsymbol(&Qbutton6up, "button6up");
4466         defsymbol(&Qbutton7up, "button7up");
4467         defsymbol(&Qbutton8up, "button8up");
4468         defsymbol(&Qbutton9up, "button9up");
4469         defsymbol(&Qbutton10up, "button10up");
4470         defsymbol(&Qbutton11up, "button11up");
4471         defsymbol(&Qbutton12up, "button12up");
4472         defsymbol(&Qbutton13up, "button13up");
4473         defsymbol(&Qbutton14up, "button14up");
4474         defsymbol(&Qbutton15up, "button15up");
4475         defsymbol(&Qbutton16up, "button16up");
4476         defsymbol(&Qbutton17up, "button17up");
4477         defsymbol(&Qbutton18up, "button18up");
4478         defsymbol(&Qbutton19up, "button19up");
4479         defsymbol(&Qbutton20up, "button20up");
4480         defsymbol(&Qbutton21up, "button21up");
4481         defsymbol(&Qbutton22up, "button22up");
4482         defsymbol(&Qbutton23up, "button23up");
4483         defsymbol(&Qbutton24up, "button24up");
4484         defsymbol(&Qbutton25up, "button25up");
4485         defsymbol(&Qbutton26up, "button26up");
4486         defsymbol(&Qbutton27up, "button27up");
4487         defsymbol(&Qbutton28up, "button28up");
4488         defsymbol(&Qbutton29up, "button29up");
4489         defsymbol(&Qbutton30up, "button30up");
4490         defsymbol(&Qbutton31up, "button31up");
4491         defsymbol(&Qbutton32up, "button32up");
4492         defsymbol(&Qmouse_1, "mouse-1");
4493         defsymbol(&Qmouse_2, "mouse-2");
4494         defsymbol(&Qmouse_3, "mouse-3");
4495         defsymbol(&Qmouse_4, "mouse-4");
4496         defsymbol(&Qmouse_5, "mouse-5");
4497         defsymbol(&Qmouse_6, "mouse-6");
4498         defsymbol(&Qmouse_7, "mouse-7");
4499         defsymbol(&Qmouse_8, "mouse-8");
4500         defsymbol(&Qmouse_9, "mouse-9");
4501         defsymbol(&Qmouse_10, "mouse-10");
4502         defsymbol(&Qmouse_11, "mouse-11");
4503         defsymbol(&Qmouse_12, "mouse-12");
4504         defsymbol(&Qmouse_13, "mouse-13");
4505         defsymbol(&Qmouse_14, "mouse-14");
4506         defsymbol(&Qmouse_15, "mouse-15");
4507         defsymbol(&Qmouse_16, "mouse-16");
4508         defsymbol(&Qmouse_17, "mouse-17");
4509         defsymbol(&Qmouse_18, "mouse-18");
4510         defsymbol(&Qmouse_19, "mouse-19");
4511         defsymbol(&Qmouse_20, "mouse-20");
4512         defsymbol(&Qmouse_21, "mouse-21");
4513         defsymbol(&Qmouse_22, "mouse-22");
4514         defsymbol(&Qmouse_23, "mouse-23");
4515         defsymbol(&Qmouse_24, "mouse-24");
4516         defsymbol(&Qmouse_25, "mouse-25");
4517         defsymbol(&Qmouse_26, "mouse-26");
4518         defsymbol(&Qmouse_27, "mouse-27");
4519         defsymbol(&Qmouse_28, "mouse-28");
4520         defsymbol(&Qmouse_29, "mouse-29");
4521         defsymbol(&Qmouse_30, "mouse-30");
4522         defsymbol(&Qmouse_31, "mouse-31");
4523         defsymbol(&Qmouse_32, "mouse-32");
4524         defsymbol(&Qdown_mouse_1, "down-mouse-1");
4525         defsymbol(&Qdown_mouse_2, "down-mouse-2");
4526         defsymbol(&Qdown_mouse_3, "down-mouse-3");
4527         defsymbol(&Qdown_mouse_4, "down-mouse-4");
4528         defsymbol(&Qdown_mouse_5, "down-mouse-5");
4529         defsymbol(&Qdown_mouse_6, "down-mouse-6");
4530         defsymbol(&Qdown_mouse_7, "down-mouse-7");
4531         defsymbol(&Qdown_mouse_8, "down-mouse-8");
4532         defsymbol(&Qdown_mouse_9, "down-mouse-9");
4533         defsymbol(&Qdown_mouse_10, "down-mouse-10");
4534         defsymbol(&Qdown_mouse_11, "down-mouse-11");
4535         defsymbol(&Qdown_mouse_12, "down-mouse-12");
4536         defsymbol(&Qdown_mouse_13, "down-mouse-13");
4537         defsymbol(&Qdown_mouse_14, "down-mouse-14");
4538         defsymbol(&Qdown_mouse_15, "down-mouse-15");
4539         defsymbol(&Qdown_mouse_16, "down-mouse-16");
4540         defsymbol(&Qdown_mouse_17, "down-mouse-17");
4541         defsymbol(&Qdown_mouse_18, "down-mouse-18");
4542         defsymbol(&Qdown_mouse_19, "down-mouse-19");
4543         defsymbol(&Qdown_mouse_20, "down-mouse-20");
4544         defsymbol(&Qdown_mouse_21, "down-mouse-21");
4545         defsymbol(&Qdown_mouse_22, "down-mouse-22");
4546         defsymbol(&Qdown_mouse_23, "down-mouse-23");
4547         defsymbol(&Qdown_mouse_24, "down-mouse-24");
4548         defsymbol(&Qdown_mouse_25, "down-mouse-25");
4549         defsymbol(&Qdown_mouse_26, "down-mouse-26");
4550         defsymbol(&Qdown_mouse_27, "down-mouse-27");
4551         defsymbol(&Qdown_mouse_28, "down-mouse-28");
4552         defsymbol(&Qdown_mouse_29, "down-mouse-29");
4553         defsymbol(&Qdown_mouse_30, "down-mouse-30");
4554         defsymbol(&Qdown_mouse_31, "down-mouse-31");
4555         defsymbol(&Qdown_mouse_32, "down-mouse-32");
4556         defsymbol(&Qmenu_selection, "menu-selection");
4557         defsymbol(&QLFD, "LFD");
4558         defsymbol(&QTAB, "TAB");
4559         defsymbol(&QRET, "RET");
4560         defsymbol(&QESC, "ESC");
4561         defsymbol(&QDEL, "DEL");
4562         defsymbol(&QSPC, "SPC");
4563         defsymbol(&QBS, "BS");
4564 }
4565
4566 void vars_of_keymap(void)
4567 {
4568         DEFVAR_LISP("meta-prefix-char", &Vmeta_prefix_char      /*
4569 Meta-prefix character.
4570 This character followed by some character `foo' turns into `Meta-foo'.
4571 This can be any form recognized as a single key specifier.
4572 To disable the meta-prefix-char, set it to a negative number.
4573                                                                  */ );
4574         Vmeta_prefix_char = make_char(033);
4575
4576         DEFVAR_LISP("mouse-grabbed-buffer", &Vmouse_grabbed_buffer      /*
4577 A buffer which should be consulted first for all mouse activity.
4578 When a mouse-click is processed, it will first be looked up in the
4579 local-map of this buffer, and then through the normal mechanism if there
4580 is no binding for that click.  This buffer's value of `mode-motion-hook'
4581 will be consulted instead of the `mode-motion-hook' of the buffer of the
4582 window under the mouse.  You should *bind* this, not set it.
4583                                                                          */ );
4584         Vmouse_grabbed_buffer = Qnil;
4585
4586         DEFVAR_LISP("overriding-local-map", &Voverriding_local_map      /*
4587 Keymap that overrides all other local keymaps.
4588 If this variable is non-nil, it is used as a keymap instead of the
4589 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4590 You should *bind* this, not set it.
4591                                                                          */ );
4592         Voverriding_local_map = Qnil;
4593
4594         Fset(Qminor_mode_map_alist, Qnil);
4595
4596         DEFVAR_LISP("key-translation-map", &Vkey_translation_map /*
4597 Keymap of key translations that can override keymaps.
4598
4599 This keymap works like `function-key-map', but is searched before it,
4600 and applies even for keys that have ordinary bindings.
4601
4602 The `read-key-sequence' function replaces any subsequence bound by
4603 `key-translation-map' with its binding.  More precisely, when the active
4604 keymaps have no binding for the current key sequence but
4605 `key-translation-map' binds a suffix of the sequence to a vector or string,
4606 `read-key-sequence' replaces the matching suffix with its binding, and
4607 continues with the new sequence.  See `key-binding' for details.
4608
4609 The events that come from bindings in `key-translation-map' are not
4610 themselves looked up in `key-translation-map'.
4611
4612 #### FIXME: stolen from `function-key-map'; need better example.
4613 #### I guess you could implement a Dvorak keyboard with this?
4614 For example, suppose `key-translation-map' binds `ESC O P' to [f1].
4615 Typing `ESC O P' to `read-key-sequence' would return
4616 \[#<keypress-event f1>].  Typing `C-x ESC O P' would return
4617 \[#<keypress-event control-X> #<keypress-event f1>].  If [f1]
4618 were a prefix key, typing `ESC O P x' would return
4619 \[#<keypress-event f1> #<keypress-event x>].
4620                                                                  */ );
4621         Vkey_translation_map = Qnil;
4622
4623         DEFVAR_LISP ("global-tty-map", &Vglobal_tty_map /*
4624 Global keymap that applies only to TTY's.
4625 Key bindings are looked up in this map just before looking in the global map,
4626 but only when the current console is a TTY console.  See also
4627 `global-window-system-map'.
4628                                                         */ );
4629         Vglobal_tty_map = Qnil;
4630
4631         DEFVAR_LISP ("global-window-system-map", &Vglobal_window_system_map /*
4632 Global keymap that applies only to window systems.
4633 Key bindings are looked up in this map just before looking in the global map,
4634 but only when the current console is not a TTY console.  See also
4635 `global-tty-map'.
4636                                                                             */ );
4637         Vglobal_window_system_map = Qnil;
4638
4639         DEFVAR_LISP("vertical-divider-map", &Vvertical_divider_map      /*
4640 Keymap which handles mouse clicks over vertical dividers.
4641                                                                          */ );
4642         Vvertical_divider_map = Qnil;
4643
4644         DEFVAR_INT("keymap-tick", &keymap_tick  /*
4645 Incremented for each change to any keymap.
4646                                                  */ );
4647         keymap_tick = 0;
4648
4649         staticpro(&Vcurrent_global_map);
4650
4651         Vsingle_space_string = make_string((const Bufbyte *)" ", 1);
4652         staticpro(&Vsingle_space_string);
4653 }
4654
4655 void complex_vars_of_keymap(void)
4656 {
4657         /* This function can GC */
4658         Lisp_Object ESC_prefix = intern("ESC-prefix");
4659         Lisp_Object meta_disgustitute;
4660
4661         Vcurrent_global_map = Fmake_keymap(Qnil);
4662         Vglobal_tty_map = Fmake_keymap (intern ("global-tty-map"));
4663         Vglobal_window_system_map =
4664                 Fmake_keymap (intern ("global-window-system-map"));
4665
4666         meta_disgustitute = Fmake_keymap(Qnil);
4667         Ffset(ESC_prefix, meta_disgustitute);
4668         /* no need to protect meta_disgustitute, though */
4669         keymap_store_internal(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
4670                               XKEYMAP(Vcurrent_global_map), meta_disgustitute);
4671         XKEYMAP(Vcurrent_global_map)->sub_maps_cache = Qt;
4672
4673         Vkey_translation_map =
4674             Fmake_sparse_keymap(intern("key-translation-map"));
4675 }