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