annotate src/keymap.c @ 5167:e374ea766cc1

clean up, rearrange allocation statistics code -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-03-21 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (assert_proper_sizing): * alloc.c (c_readonly): * alloc.c (malloced_storage_size): * alloc.c (fixed_type_block_overhead): * alloc.c (lisp_object_storage_size): * alloc.c (inc_lrecord_stats): * alloc.c (dec_lrecord_stats): * alloc.c (pluralize_word): * alloc.c (object_memory_usage_stats): * alloc.c (Fobject_memory_usage): * alloc.c (compute_memusage_stats_length): * alloc.c (disksave_object_finalization_1): * alloc.c (Fgarbage_collect): * mc-alloc.c: * mc-alloc.c (mc_alloced_storage_size): * mc-alloc.h: No functionality change here. Collect the allocations-statistics code that was scattered throughout alloc.c into one place. Add remaining section headings so that all sections have headings clearly identifying the start of the section and its purpose. Expose mc_alloced_storage_size() even when not MEMORY_USAGE_STATS; this fixes build problems and is related to the export of lisp_object_storage_size() and malloced_storage_size() when non-MEMORY_USAGE_STATS in the previous change set.
author Ben Wing <ben@xemacs.org>
date Sun, 21 Mar 2010 04:41:49 -0500
parents 88bd4f3ef8e4
children 2e528066e2fc
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Manipulation of keymaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1991-1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1995 Sun Microsystems, Inc.
5050
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
5 Copyright (C) 2001, 2002, 2010 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 Totally redesigned by jwz in 1991.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 different from FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "bytecode.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
34 #include "console-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "events.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
37 #include "extents.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "keymap.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 /* A keymap contains six slots:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 parents Ordered list of keymaps to search after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 this one if no match is found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 Keymaps can thus be arranged in a hierarchy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 table A hash table, hashing keysyms to their bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 It will be one of the following:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
53 -- a symbol, e.g. `home'
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 -- a character, representing something printable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 (not ?\C-c meaning C-c, for instance)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 -- an integer representing a modifier combination
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 inverse_table A hash table, hashing bindings to the list of keysyms
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 in this keymap which are bound to them. This is to make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 the Fwhere_is_internal() function be fast. It needs to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 fast because we want to be able to call it in realtime to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 update the keyboard-equivalents on the pulldown menus.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Values of the table are either atoms (keysyms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 or a dotted list of keysyms.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 sub_maps_cache An alist; for each entry in this keymap whose binding is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 a keymap (that is, Fkeymapp()) this alist associates that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 keysym with that binding. This is used to optimize both
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Fwhere_is_internal() and Faccessible_keymaps(). This slot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 gets set to the symbol `t' every time a change is made to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 this keymap, causing it to be recomputed when next needed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 prompt See `set-keymap-prompt'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 default_binding See `set-keymap-default-binding'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 Sequences of keys are stored in the obvious way: if the sequence of keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 "abc" was bound to some command `foo', the hierarchy would look like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 keymap-1: associates "a" with keymap-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 keymap-2: associates "b" with keymap-3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 keymap-3: associates "c" with foo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 However, bucky bits ("modifiers" to the X-minded) are represented in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Each combination of modifiers (e.g. control-hyper) gets its own submap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 off of the main map. The hash key for a modifier combination is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 an integer, computed by MAKE_MODIFIER_HASH_KEY().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 If the key `C-a' was bound to some command, the hierarchy would look like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
92 keymap-1: associates the integer XEMACS_MOD_CONTROL with keymap-2
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 keymap-2: associates "a" with the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 would look like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
98 keymap-1: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 with keymap-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 keymap-2: associates "a" with the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Note that a special exception is made for the meta modifier, in order
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 to deal with ESC/meta lossage. Any key combination containing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 meta modifier is first indexed off of the main map into the meta
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
105 submap (with hash key XEMACS_MOD_META) and then indexed off of the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 meta submap with the meta modifier removed from the key combination.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 For example, when associating a command with C-M-H-a, we'd have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
109 keymap-1: associates the integer XEMACS_MOD_META with keymap-2
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
110 keymap-2: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 with keymap-3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 keymap-3: associates "a" with the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Note that keymap-2 might have normal bindings in it; these would be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 for key combinations containing only the meta modifier, such as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 M-y or meta-backspace.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 If the command that "a" was bound to in keymap-3 was itself a keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 then that would make the key "C-M-H-a" be a prefix character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 Note that this new model of keymaps takes much of the magic away from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 the Escape key: the value of the variable `esc-map' is no longer indexed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 in the `global-map' under the ESC key. It's indexed under the integer
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
124 XEMACS_MOD_META. This is not user-visible, however; none of the "bucky"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 maps are.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 and (define-key some-random-map "\^[" my-esc-map) work as before, for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 Since keymaps are opaque, the only way to extract information from them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 is with the functions lookup-key, key-binding, local-key-binding, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 global-key-binding, which work just as before, and the new function
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
134 map-keymap, which is roughly analogous to maphash.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 Note that map-keymap perpetuates the illusion that the "bucky" submaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 don't exist: if you map over a keymap with bucky submaps, it will also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 map over those submaps. It does not, however, map over other random
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 submaps of the keymap, just the bucky ones.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 One implication of this is that when you map over `global-map', you will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 also map over `esc-map'. It is merely for compatibility that the esc-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 is accessible at all; I think that's a bad thing, since it blurs the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 distinction between ESC and "meta" even more. "M-x" is no more a two-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 key sequence than "C-x" is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
149 struct Lisp_Keymap
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 {
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
151 NORMAL_LISP_OBJECT_HEADER header;
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
152 #define MARKED_SLOT(x) Lisp_Object x;
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
153 #include "keymap-slots.h"
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
154 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 /* Actually allocate storage for these variables */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
163 Lisp_Object Vcurrent_global_map; /* Always a keymap */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
165 static Lisp_Object Vglobal_tty_map, Vglobal_window_system_map;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
166
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 static Lisp_Object Vmouse_grabbed_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 /* Alist of minor mode variables and keymaps. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 static Lisp_Object Qminor_mode_map_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 static Lisp_Object Voverriding_local_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 static Lisp_Object Vkey_translation_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 static Lisp_Object Vvertical_divider_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 /* This is incremented whenever a change is made to a keymap. This is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 so that things which care (such as the menubar code) can recompute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 privately-cached data when the user has changed keybindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
182 Fixnum keymap_tick;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 /* Prefixing a key with this character is the same as sending a meta bit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Lisp_Object Vmeta_prefix_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 Lisp_Object Qkeymapp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 Lisp_Object Vsingle_space_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 Lisp_Object Qsuppress_keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 Lisp_Object Qmodeline_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 Lisp_Object Qtoolbar_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 EXFUN (Fkeymap_fullness, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 EXFUN (Fset_keymap_name, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 EXFUN (Fsingle_key_description, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 static void describe_command (Lisp_Object definition, Lisp_Object buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 void (*elt_describer) (Lisp_Object, Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 int partial,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 Lisp_Object shadow,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 int mice_only_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 Lisp_Object buffer);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
204 static Lisp_Object keymap_submaps (Lisp_Object keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
207
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
208 #define INCLUDE_BUTTON_ZERO
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
209 #define FROB(num) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
210 Lisp_Object Qbutton##num; \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
211 Lisp_Object Qbutton##num##up;
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
212 #include "keymap-buttons.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 Lisp_Object Qmenu_selection;
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
215
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 /* Emacs compatibility */
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
217 #define FROB(num) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
218 Lisp_Object Qmouse_##num; \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
219 Lisp_Object Qdown_mouse_##num;
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
220 #include "keymap-buttons.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 /* Kludge kludge kludge */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 /* The keymap Lisp object */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
230 /* Keymaps are equal if Faces are equal if all of their display attributes are equal. We
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
231 don't compare names or doc-strings, because that would make equal
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
232 be eq.
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
233
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
234 This isn't concerned with "unspecified" attributes, that's what
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
235 #'face-differs-from-default-p is for. */
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
236 static int
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
237 keymap_equal (Lisp_Object obj1, Lisp_Object obj2, int depth,
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
238 int UNUSED (foldcase))
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
239 {
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
240 Lisp_Keymap *k1 = XKEYMAP (obj1);
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
241 Lisp_Keymap *k2 = XKEYMAP (obj2);
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
242
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
243 depth++;
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
244
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
245 return
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
246 (
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
247 #define MARKED_SLOT(x) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
248 internal_equal (k1->x, k2->x, depth) &&
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
249 #define MARKED_SLOT_NOCOMPARE(x)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
250 #include "keymap-slots.h"
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
251 1
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
252 );
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
253 }
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
254
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
255 static Hashcode
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
256 keymap_hash (Lisp_Object obj, int depth)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
257 {
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
258 Lisp_Keymap *k = XKEYMAP (obj);
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
259 Hashcode hash = 0xCAFEBABE; /* why not? */
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
260
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
261 depth++;
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
262
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
263 #define MARKED_SLOT(x) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
264 hash = HASH2 (hash, internal_hash (k->x, depth));
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
265 #define MARKED_SLOT_NOCOMPARE(x)
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
266 #include "keymap-slots.h"
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
267
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
268 return hash;
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
269 }
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
270
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 mark_keymap (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 Lisp_Keymap *keymap = XKEYMAP (obj);
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
275 #define MARKED_SLOT(x) mark_object (keymap->x);
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
276 #include "keymap-slots.h"
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
277 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2027
diff changeset
281 print_keymap (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2027
diff changeset
282 int UNUSED (escapeflag))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 Lisp_Keymap *keymap = XKEYMAP (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 if (print_readably)
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5128
diff changeset
287 printing_unreadable_lisp_object (obj, 0);
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
288 write_ascstring (printcharfun, "#<keymap ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 if (!NILP (keymap->name))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
290 {
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
291 write_fmt_string_lisp (printcharfun, "%S ", 1, keymap->name);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
292 }
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
293 write_fmt_string (printcharfun, "size %ld 0x%x>",
5146
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
294 (long) XINT (Fkeymap_fullness (obj)),
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents: 5142
diff changeset
295 LISP_OBJECT_UID (obj));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
298 static const struct memory_description keymap_description[] = {
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
299 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (Lisp_Keymap, x) },
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
300 #include "keymap-slots.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4780
diff changeset
304 DEFINE_DUMPABLE_LISP_OBJECT ("keymap", keymap,
5125
Ben Wing <ben@xemacs.org>
parents: 5124 5013
diff changeset
305 mark_keymap, print_keymap, 0,
Ben Wing <ben@xemacs.org>
parents: 5124 5013
diff changeset
306 keymap_equal, keymap_hash,
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
307 keymap_description,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5120
diff changeset
308 Lisp_Keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 /* Traversing keymaps and their parents */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 void *mapper_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 Lisp_Object keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 Lisp_Object tail = start_parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 Lisp_Object malloc_sucks[10];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 Lisp_Object malloc_bites = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 int stack_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 gcpro1.nvars = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 start_keymap = get_keymap (start_keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 keymap = start_keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 /* Hack special-case parents at top-level */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
332 tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 QUIT;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
339 result = mapper (keymap, mapper_arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 while (CONSP (malloc_bites))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
344 Lisp_Object victim = malloc_bites;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
345 malloc_bites = XCDR (victim);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 free_cons (victim);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 if (stack_depth == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 return Qnil; /* Nothing found */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 stack_depth--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 if (CONSP (malloc_bites))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
361 Lisp_Object victim = malloc_bites;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
362 tail = XCAR (victim);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 826
diff changeset
363 malloc_bites = XCDR (victim);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 free_cons (victim);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 tail = malloc_sucks[stack_depth];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 gcpro1.nvars = stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 keymap = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 Lisp_Object parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 keymap = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 parents = XKEYMAP (keymap)->parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 if (!CONSP (parents))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 else if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 /* Tail-recurse */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 tail = parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 if (CONSP (malloc_bites))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 malloc_bites = noseeum_cons (tail, malloc_bites);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 else if (stack_depth < countof (malloc_sucks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 malloc_sucks[stack_depth++] = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 gcpro1.nvars = stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 for (i = 0, malloc_bites = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 i < countof (malloc_sucks);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 malloc_bites = noseeum_cons (malloc_sucks[i],
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 malloc_bites);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 gcpro1.nvars = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 tail = parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 if (EQ (keymap, start_keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
412 invalid_argument ("Cyclic keymap indirection", start_keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 /* Some low-level functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
422 static int
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 bucky_sym_to_bucky_bit (Lisp_Object sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
425 if (EQ (sym, Qcontrol)) return XEMACS_MOD_CONTROL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
426 if (EQ (sym, Qmeta)) return XEMACS_MOD_META;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
427 if (EQ (sym, Qsuper)) return XEMACS_MOD_SUPER;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
428 if (EQ (sym, Qhyper)) return XEMACS_MOD_HYPER;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
429 if (EQ (sym, Qalt)) return XEMACS_MOD_ALT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
430 if (EQ (sym, Qsymbol)) return XEMACS_MOD_ALT; /* #### - reverse compat */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
431 if (EQ (sym, Qshift)) return XEMACS_MOD_SHIFT;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
437 control_meta_superify (Lisp_Object frob, int modifiers)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 if (modifiers == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 return frob;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 frob = Fcons (frob, Qnil);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
442 if (modifiers & XEMACS_MOD_SHIFT) frob = Fcons (Qshift, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
443 if (modifiers & XEMACS_MOD_ALT) frob = Fcons (Qalt, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
444 if (modifiers & XEMACS_MOD_HYPER) frob = Fcons (Qhyper, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
445 if (modifiers & XEMACS_MOD_SUPER) frob = Fcons (Qsuper, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
446 if (modifiers & XEMACS_MOD_CONTROL) frob = Fcons (Qcontrol, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
447 if (modifiers & XEMACS_MOD_META) frob = Fcons (Qmeta, frob);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 return frob;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 static Lisp_Object
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
452 make_key_description (const Lisp_Key_Data *key, int prettify)
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
453 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
454 Lisp_Object keysym = KEY_DATA_KEYSYM (key);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
455 int modifiers = KEY_DATA_MODIFIERS (key);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 if (prettify && CHARP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 /* This is a little slow, but (control a) is prettier than (control 65).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 It's now ok to do this for digit-chars too, since we've fixed the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 bug where \9 read as the integer 9 instead of as the symbol with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 "9" as its name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 /* !!#### I'm not sure how correct this is. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
464 Ibyte str [1 + MAX_ICHAR_LEN];
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
465 Bytecount count = set_itext_ichar (str, XCHAR (keysym));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 str[count] = 0;
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
467 keysym = intern_istring (str);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 return control_meta_superify (keysym, modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 /* Low-level keymap-store functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 raw_lookup_key (Lisp_Object keymap,
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
479 const Lisp_Key_Data *raw_keys, int raw_keys_count,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 int keys_so_far, int accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 /* Relies on caller to gc-protect args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 keymap_lookup_directly (Lisp_Object keymap,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
485 Lisp_Object keysym, int modifiers)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 Lisp_Keymap *k;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
489 modifiers &= ~(
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
490 #define FROB(num) XEMACS_MOD_BUTTON##num |
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
491 #include "keymap-buttons.h"
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
492 0);
5050
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
493 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META |
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
494 XEMACS_MOD_SUPER | XEMACS_MOD_HYPER |
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
495 XEMACS_MOD_ALT | XEMACS_MOD_SHIFT))
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
496 == 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 k = XKEYMAP (keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 /* If the keysym is a one-character symbol, use the char code instead. */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
501 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 Lisp_Object i_fart_on_gcc =
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
504 make_char (string_ichar (XSYMBOL (keysym)->name, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 keysym = i_fart_on_gcc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
508 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
510 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 if (NILP (submap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 k = XKEYMAP (submap);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
515 modifiers &= ~XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 if (modifiers != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 if (NILP (submap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 k = XKEYMAP (submap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 return Fgethash (keysym, k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 keymap_store_inverse_internal (Lisp_Object inverse_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 Lisp_Object keysym,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 if (UNBOUNDP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 keys = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 /* Don't cons this unless necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 /* keys = Fcons (keysym, Qnil); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 Fputhash (value, keys, inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 else if (!CONSP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 /* Now it's necessary to cons */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 keys = Fcons (keys, keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 Fputhash (value, keys, inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 while (CONSP (XCDR (keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 keys = XCDR (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 XCDR (keys) = Fcons (XCDR (keys), keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 /* No need to call puthash because we've destructively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 modified the list tail in place */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 keymap_delete_inverse_internal (Lisp_Object inverse_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 Lisp_Object keysym,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 Lisp_Object new_keys = keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 Lisp_Object *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
5050
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
570 assert (!UNBOUNDP (keys));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 for (prev = &new_keys, tail = new_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 prev = &(XCDR (tail)), tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 if (EQ (tail, keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 *prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 else if (EQ (keysym, XCAR (tail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 *prev = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 if (NILP (new_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 Fremhash (value, inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 else if (!EQ (keys, new_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 /* Removed the first elt */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 Fputhash (value, new_keys, inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 /* else the list's tail has been modified, so we don't need to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 touch the hash table again (the pointer in there is ok).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
598 /* Prevent luser from shooting herself in the foot using something like
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
599 (define-key ctl-x-4-map "p" global-map) */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
600 static void
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
601 check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
602 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
603 def = get_keymap (def, 0, 0);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
604
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
605 if (KEYMAPP (def))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
606 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
607 Lisp_Object maps;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
608
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
609 if (XKEYMAP (def) == to_keymap)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
610 invalid_argument ("Cyclic keymap definition", def);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
611
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
612 for (maps = keymap_submaps (def);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
613 CONSP (maps);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
614 maps = XCDR (maps))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
615 check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
616 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
617 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
621 Lisp_Object def)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
623 Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
624
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
625 if (EQ (prev_def, def))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 return;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
627
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
628 check_keymap_definition_loop (def, keymap);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
629
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
630 if (!NILP (prev_def))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 keymap_delete_inverse_internal (keymap->inverse_table,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
632 keysym, prev_def);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
633 if (NILP (def))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 Fremhash (keysym, keymap->table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
639 Fputhash (keysym, def, keymap->table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 keymap_store_inverse_internal (keymap->inverse_table,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
641 keysym, def);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 keymap_tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
648 create_bucky_submap (Lisp_Keymap *k, int modifiers,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 Lisp_Object parent_for_debugging_info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 /* User won't see this, but it is nice for debugging Emacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 XKEYMAP (submap)->name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 = control_meta_superify (parent_for_debugging_info, modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 /* Invalidate cache */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 k->sub_maps_cache = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 return submap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 /* Relies on caller to gc-protect keymap, keysym, value */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 static void
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
664 keymap_store (Lisp_Object keymap, const Lisp_Key_Data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
667 Lisp_Object keysym = KEY_DATA_KEYSYM (key);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
668 int modifiers = KEY_DATA_MODIFIERS (key);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
669 Lisp_Keymap *k = XKEYMAP (keymap);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
670
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
671 modifiers &= ~(
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
672 #define FROB(num) XEMACS_MOD_BUTTON##num |
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
673 #include "keymap-buttons.h"
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
674 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
675 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
676 | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
677 | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 /* If the keysym is a one-character symbol, use the char code instead. */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
680 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
681 keysym = make_char (string_ichar (XSYMBOL (keysym)->name, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
683 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 if (NILP (submap))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
688 submap = create_bucky_submap (k, XEMACS_MOD_META, keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 k = XKEYMAP (submap);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
690 modifiers &= ~XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 if (modifiers != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 if (NILP (submap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 submap = create_bucky_submap (k, modifiers, keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 k = XKEYMAP (submap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 k->sub_maps_cache = Qt; /* Invalidate cache */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 keymap_store_internal (keysym, k, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 /* Listing the submaps of a keymap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 struct keymap_submaps_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 Lisp_Object *result_locative;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2027
diff changeset
716 keymap_submaps_mapper_0 (Lisp_Object UNUSED (key), Lisp_Object value,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2027
diff changeset
717 void *UNUSED (keymap_submaps_closure))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 /* Perform any autoloads, etc */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 Fkeymapp (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 void *keymap_submaps_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 Lisp_Object *result_locative;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 struct keymap_submaps_closure *cl =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 (struct keymap_submaps_closure *) keymap_submaps_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 result_locative = cl->result_locative;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 if (!NILP (Fkeymapp (value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 *result_locative = Fcons (Fcons (key, value), *result_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 Lisp_Object pred);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 keymap_submaps (Lisp_Object keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 Lisp_Keymap *k = XKEYMAP (keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 struct keymap_submaps_closure keymap_submaps_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 GCPRO2 (keymap, result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 keymap_submaps_closure.result_locative = &result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 /* Do this first pass to touch (and load) any autoloaded maps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 elisp_maphash (keymap_submaps_mapper_0, k->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 &keymap_submaps_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 elisp_maphash (keymap_submaps_mapper, k->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 &keymap_submaps_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 /* keep it sorted so that the result of accessible-keymaps is ordered */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 k->sub_maps_cache = list_sort (result,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 map_keymap_sort_predicate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 return k->sub_maps_cache;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 /* Basic operations on keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 static Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
778 make_keymap (Elemcount size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 {
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5126
diff changeset
780 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (keymap);
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
781 Lisp_Keymap *keymap = XKEYMAP (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
783 #define MARKED_SLOT(x) keymap->x = Qnil;
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
784 #include "keymap-slots.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 if (size != 0) /* hack for copy-keymap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 keymap->table =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 /* Inverse table is often less dense because of duplicate key-bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 If not, it will grow anyway. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 keymap->inverse_table =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
793 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK,
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
794 HASH_TABLE_EQ);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 }
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
796 return obj;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 Construct and return a new keymap object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 All entries in it are nil, meaning "command undefined".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 Optional argument NAME specifies a name to assign to the keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 as in `set-keymap-name'. This name is only a debugging convenience;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 it is not used except when printing the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 Lisp_Object keymap = make_keymap (60);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 if (!NILP (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 Fset_keymap_name (keymap, name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 return keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 Construct and return a new keymap object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 All entries in it are nil, meaning "command undefined". The only
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
818 difference between this function and `make-keymap' is that this function
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 returns a "smaller" keymap (one that is expected to contain fewer
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
820 entries). As keymaps dynamically resize, this distinction is not great.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 Optional argument NAME specifies a name to assign to the keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 as in `set-keymap-name'. This name is only a debugging convenience;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 it is not used except when printing the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 Lisp_Object keymap = make_keymap (8);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 if (!NILP (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 Fset_keymap_name (keymap, name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 return keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 Return the `parent' keymaps of KEYMAP, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 The parents of a keymap are searched for keybindings when a key sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 isn't bound in this one. `(current-global-map)' is the default parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 of all keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 return Fcopy_sequence (XKEYMAP (keymap)->parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2027
diff changeset
849 traverse_keymaps_noop (Lisp_Object UNUSED (keymap), void *UNUSED (arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 Set the `parent' keymaps of KEYMAP to PARENTS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 The parents of a keymap are searched for keybindings when a key sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 isn't bound in this one. `(current-global-map)' is the default parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 of all keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 (keymap, parents))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 Lisp_Object k;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 GCPRO2 (keymap, parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 if (KEYMAPP (parents)) /* backwards-compatibility */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 parents = list1 (parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 if (!NILP (parents))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 Lisp_Object tail = parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 CHECK_CONS (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 k = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 /* Require that it be an actual keymap object, rather than a symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 with a (crockish) symbol-function which is a keymap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 /* Check for circularities */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 keymap_tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 return parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 Set the `name' of the KEYMAP to NEW-NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 The name is only a debugging convenience; it is not used except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 when printing the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (keymap, new_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 XKEYMAP (keymap)->name = new_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 return new_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 Return the `name' of KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 The name is only a debugging convenience; it is not used except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 when printing the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 return XKEYMAP (keymap)->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 if no prompt is desired. The prompt is shown in the echo-area
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 when reading a key-sequence to be looked-up in this keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 (keymap, new_prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 if (!NILP (new_prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 CHECK_STRING (new_prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 XKEYMAP (keymap)->prompt = new_prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 return new_prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2027
diff changeset
936 keymap_prompt_mapper (Lisp_Object keymap, void *UNUSED (arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 return XKEYMAP (keymap)->prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 Return the `prompt' of KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 If non-nil, the prompt is shown in the echo-area
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 when reading a key-sequence to be looked-up in this keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 (keymap, use_inherited))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 Lisp_Object prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 prompt = XKEYMAP (keymap)->prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 if (!NILP (prompt) || NILP (use_inherited))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 return prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 Sets the default binding of KEYMAP to COMMAND, or `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 if no default is desired. The default-binding is returned when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 no other binding for a key-sequence is found in the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 If a keymap has a non-nil default-binding, neither the keymap's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 parents nor the current global map are searched for key bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 (keymap, command))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 XKEYMAP (keymap)->default_binding = command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 return command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 Return the default binding of KEYMAP, or `nil' if it has none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 The default-binding is returned when no other binding for a key-sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 is found in the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 If a keymap has a non-nil default-binding, neither the keymap's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 parents nor the current global map are searched for key bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 return XKEYMAP (keymap)->default_binding;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
991 Return t if OBJECT is a keymap object.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 The keymap may be autoloaded first if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 /* Check that OBJECT is a keymap (after dereferencing through any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 symbols). If it is, return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 is an autoload form, do the autoload and try again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 If AUTOLOAD is nonzero, callers must assume GC is possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 ERRORP controls how we respond if OBJECT isn't a keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 Note that most of the time, we don't want to pursue autoloads.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 Functions like Faccessible_keymaps which scan entire keymap trees
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 shouldn't load every autoloaded keymap. I'm not sure about this,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 but it seems to me that only read_key_sequence, Flookup_key, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 Fdefine_key should cause keymaps to be autoloaded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 get_keymap (Lisp_Object object, int errorp, int autoload)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 Lisp_Object tem = indirect_function (object, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 if (KEYMAPP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 /* Should we do an autoload? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 else if (autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 /* (autoload "filename" doc nil keymap) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 && SYMBOLP (object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 && CONSP (tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 && EQ (XCAR (tem), Qautoload)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 {
970
0dc7756a58c4 [xemacs-hg @ 2002-08-22 11:31:39 by stephent]
stephent
parents: 934
diff changeset
1034 /* do_autoload GCPROs both arguments */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 do_autoload (tem, object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 else if (errorp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 object = wrong_type_argument (Qkeymapp, object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 /* Given OBJECT which was found in a slot in a keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 trace indirect definitions to get the actual definition of that slot.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 An indirect definition is a list of the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 get_keyelt (Lisp_Object object, int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 Lisp_Object map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 tail_recurse:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 if (!CONSP (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 return object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 GCPRO1 (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 map = XCAR (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 map = get_keymap (map, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 if (!NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 Lisp_Object idx = Fcdr (object);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1071 Lisp_Key_Data indirection;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 if (CHARP (idx))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1074 Lisp_Object event = Fmake_event (Qnil, Qnil);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1075 struct gcpro gcpro1;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1076 GCPRO1 (event);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1077 character_to_event (XCHAR (idx), XEVENT (event),
4780
2fd201d73a92 Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 4355
diff changeset
1078 XCONSOLE (Vselected_console),
2fd201d73a92 Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 4355
diff changeset
1079 high_bit_is_meta, 0);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1080 indirection.keysym = XEVENT_KEY_KEYSYM (event);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1081 indirection.modifiers = XEVENT_KEY_MODIFIERS (event);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1082 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 else if (CONSP (idx))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 if (!INTP (XCDR (idx)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 indirection.keysym = XCAR (idx);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1089 indirection.modifiers = (unsigned char) XINT (XCDR (idx));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 else if (SYMBOLP (idx))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 indirection.keysym = idx;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1094 SET_KEY_DATA_MODIFIERS (&indirection, XINT (XCDR (idx)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 /* Random junk */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 else if (STRINGP (XCAR (object)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 /* If the keymap contents looks like (STRING . DEFN),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 use DEFN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 Keymap alist elements like (CHAR MENUSTRING . DEFN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 will be used by HierarKey menus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 object = XCDR (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 goto tail_recurse;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 /* Anything else is really the value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 return object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 static Lisp_Object
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1120 keymap_lookup_1 (Lisp_Object keymap, const Lisp_Key_Data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 /* This function can GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1124 return get_keyelt (keymap_lookup_directly (keymap,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1125 KEY_DATA_KEYSYM (key),
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1126 KEY_DATA_MODIFIERS (key)),
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1127 accept_default);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 /* Copying keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 struct copy_keymap_inverse_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 Lisp_Object inverse_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 void *copy_keymap_inverse_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 struct copy_keymap_inverse_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 /* copy-sequence deals with dotted lists. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 if (CONSP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 value = Fcopy_list (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 Fputhash (key, value, closure->inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 copy_keymap_internal (Lisp_Keymap *keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 Lisp_Object nkm = make_keymap (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 new_keymap->parents = Fcopy_sequence (keymap->parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 new_keymap->sub_maps_cache = Qnil; /* No submaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 new_keymap->table = Fcopy_hash_table (keymap->table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 new_keymap->default_binding = keymap->default_binding;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 /* After copying the inverse map, we need to copy the conses which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 are its values, lest they be shared by the copy, and mangled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 &copy_keymap_inverse_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 return nkm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 static Lisp_Object copy_keymap (Lisp_Object keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 struct copy_keymap_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 Lisp_Keymap *self;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 copy_keymap_mapper (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 void *copy_keymap_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 struct copy_keymap_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 (struct copy_keymap_closure *) copy_keymap_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 /* When we encounter a keymap which is indirected through a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 symbol, we need to copy the sub-map. In v18, the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 (lookup-key (copy-keymap global-map) "\C-x")
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1196 returned a new keymap, not the symbol `Control-X-prefix'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 if (KEYMAPP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 keymap_store_internal (key, closure->self,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 copy_keymap (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 copy_keymap (Lisp_Object keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 struct copy_keymap_closure copy_keymap_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 keymap = copy_keymap_internal (XKEYMAP (keymap));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 copy_keymap_closure.self = XKEYMAP (keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 elisp_maphash (copy_keymap_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 XKEYMAP (keymap)->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 &copy_keymap_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 return keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 Return a copy of the keymap KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 The copy starts out with the same definitions of KEYMAP,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 but changing either the copy or KEYMAP does not affect the other.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 Any key definitions that are subkeymaps are recursively copied.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 return copy_keymap (keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 keymap_fullness (Lisp_Object keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 int fullness;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 Lisp_Object sub_maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 keymap = get_keymap (keymap, 1, 1);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1242 fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 GCPRO2 (keymap, sub_maps);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1244 for (sub_maps = keymap_submaps (keymap);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1245 !NILP (sub_maps);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1246 sub_maps = XCDR (sub_maps))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1250 Lisp_Object bucky_map = XCDR (XCAR (sub_maps));
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1251 fullness--; /* don't count bucky maps themselves. */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1252 fullness += keymap_fullness (bucky_map);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 return fullness;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 Return the number of bindings in the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 /* Defining keys in keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 /* Given a keysym (should be a symbol, int, char), make sure it's valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 and perform any necessary canonicalization. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 define_key_check_and_coerce_keysym (Lisp_Object spec,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 Lisp_Object *keysym,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1279 int modifiers)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 /* Now, check and massage the trailing keysym specifier. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 if (SYMBOLP (*keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1284 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 Lisp_Object ream_gcc_up_the_ass =
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1287 make_char (string_ichar (XSYMBOL (*keysym)->name, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 *keysym = ream_gcc_up_the_ass;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 goto fixnum_keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 else if (CHAR_OR_CHAR_INTP (*keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 CHECK_CHAR_COERCE_INT (*keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 fixnum_keysym:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 if (XCHAR (*keysym) < ' '
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 /* yuck! Can't make the above restriction; too many compatibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 problems ... */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1300 invalid_argument ("keysym char must be printable", *keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 /* #### This bites! I want to be able to write (control shift a) */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1302 if (modifiers & XEMACS_MOD_SHIFT)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1303 invalid_argument
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 ("The `shift' modifier may not be applied to ASCII keysyms",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1309 invalid_argument ("Unknown keysym specifier", *keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 if (SYMBOLP (*keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1314 Ibyte *name = XSTRING_DATA (XSYMBOL (*keysym)->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1316 /* GNU Emacs uses symbols with the printed representation of keysyms in
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1317 their names, like `M-x', and we use the syntax '(meta x). So, to
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1318 avoid confusion, notice the M-x syntax and signal an error -
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1319 because otherwise it would be interpreted as a regular keysym, and
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1320 would even show up in the list-buffers output, causing confusion
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1321 to the naive.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 We can get away with this because none of the X keysym names contain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 a hyphen (some contain underscore, however).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 It might be useful to reject keysyms which are not x-valid-keysym-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 name-p, but that would interfere with various tricks we do to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 sanitize the Sun keyboards, and would make it trickier to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 conditionalize a .emacs file for multiple X servers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1331 if (((int) qxestrlen (name) >= 2 && name[1] == '-')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 #if 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 /* Ok, this is a bit more dubious - prevent people from doing things
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 like (global-set-key 'RET 'something) because that will have the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 same problem as above. (Gag!) Maybe we should just silently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 accept these as aliases for the "real" names?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1339 (XSTRING_LENGTH (XSYMBOL (*keysym)->name) <= 3 &&
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1340 (!qxestrcmp_ascii (name, "LFD") ||
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1341 !qxestrcmp_ascii (name, "TAB") ||
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1342 !qxestrcmp_ascii (name, "RET") ||
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1343 !qxestrcmp_ascii (name, "ESC") ||
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1344 !qxestrcmp_ascii (name, "DEL") ||
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1345 !qxestrcmp_ascii (name, "SPC") ||
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1346 !qxestrcmp_ascii (name, "BS")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 #endif /* unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 )
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1349 invalid_argument
3086
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1350 ("Invalid (GNU Emacs) key format (see doc of define-key)",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 *keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 /* #### Ok, this is a bit more dubious - make people not lose if they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 do things like (global-set-key 'RET 'something) because that would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 otherwise have the same problem as above. (Gag!) We silently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 accept these as aliases for the "real" names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1358 else if (!qxestrncmp_ascii (name, "kp_", 3))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1359 {
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1360 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1361 DECLARE_EISTRING (temp);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1362 eicpy_raw (temp, name, qxestrlen (name));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1363 eisetch_char (temp, 2, '-');
4355
a2af1ff1761f Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4272
diff changeset
1364 *keysym = Fintern_soft (eimake_string (temp), Qnil, Qnil);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1365 }
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1366 else if (EQ (*keysym, QLFD))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 *keysym = QKlinefeed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 else if (EQ (*keysym, QTAB))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 *keysym = QKtab;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 else if (EQ (*keysym, QRET))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 *keysym = QKreturn;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 else if (EQ (*keysym, QESC))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 *keysym = QKescape;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 else if (EQ (*keysym, QDEL))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 *keysym = QKdelete;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 else if (EQ (*keysym, QSPC))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 *keysym = QKspace;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 else if (EQ (*keysym, QBS))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 *keysym = QKbackspace;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 /* Emacs compatibility */
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1381 #define FROB(num) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1382 else if (EQ(*keysym, Qdown_mouse_##num)) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1383 *keysym = Qbutton##num; \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1384 else if (EQ(*keysym, Qmouse_##num)) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1385 *keysym = Qbutton##num##up;
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1386 #include "keymap-buttons.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 /* Given any kind of key-specifier, return a keysym and modifier mask.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 Proper canonicalization is performed:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 -- integers are converted into the equivalent characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 -- one-character strings are converted into the equivalent characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 static void
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1399 define_key_parser (Lisp_Object spec, Lisp_Key_Data *returned_value)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 if (CHAR_OR_CHAR_INTP (spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1403 Lisp_Object event = Fmake_event (Qnil, Qnil);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1404 struct gcpro gcpro1;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1405 GCPRO1 (event);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1406 character_to_event (XCHAR_OR_CHAR_INT (spec), XEVENT (event),
4780
2fd201d73a92 Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 4355
diff changeset
1407 XCONSOLE (Vselected_console), high_bit_is_meta, 0);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1408 SET_KEY_DATA_KEYSYM (returned_value, XEVENT_KEY_KEYSYM (event));
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1409 SET_KEY_DATA_MODIFIERS (returned_value,
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1410 XEVENT_KEY_MODIFIERS (event));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1411 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 else if (EVENTP (spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1415 switch (XEVENT_TYPE (spec))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 case key_press_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1419 SET_KEY_DATA_KEYSYM (returned_value, XEVENT_KEY_KEYSYM (spec));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1420 SET_KEY_DATA_MODIFIERS (returned_value, XEVENT_KEY_MODIFIERS (spec));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 case button_press_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 case button_release_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1426 int down = (XEVENT_TYPE (spec) == button_press_event);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1427 switch (XEVENT_BUTTON_BUTTON (spec))
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1428 {
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1429 #define FROB(num) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1430 case num: \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1431 SET_KEY_DATA_KEYSYM (returned_value, \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1432 (down ? Qbutton##num : \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1433 Qbutton##num##up)); \
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1434 break;
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1435 #include "keymap-buttons.h"
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1436 default:
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1437 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton0 :
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1438 Qbutton0up));
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1439 break;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1440 }
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1441 SET_KEY_DATA_MODIFIERS (returned_value,
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1442 XEVENT_BUTTON_MODIFIERS (spec));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 default:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1446 wtaerror ("unable to bind this type of event", spec);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 else if (SYMBOLP (spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 /* Be nice, allow = to mean (=) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 if (bucky_sym_to_bucky_bit (spec) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1453 invalid_argument ("Key is a modifier name", spec);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 define_key_check_and_coerce_keysym (spec, &spec, 0);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1455 SET_KEY_DATA_KEYSYM (returned_value, spec);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1456 SET_KEY_DATA_MODIFIERS (returned_value, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 else if (CONSP (spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1460 int modifiers = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 Lisp_Object keysym = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 Lisp_Object rest = spec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 /* First, parse out the leading modifier symbols. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 while (CONSP (rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1467 int modifier;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 keysym = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 modifier = bucky_sym_to_bucky_bit (keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 modifiers |= modifier;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 if (!NILP (XCDR (rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 if (! modifier)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1475 invalid_argument ("Unknown modifier", keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 if (modifier)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1480 sferror ("Nothing but modifiers here",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 rest = XCDR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 if (!NILP (rest))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1487 signal_error (Qlist_formation_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1488 "List must be nil-terminated", spec);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1491 SET_KEY_DATA_KEYSYM(returned_value, keysym);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1492 SET_KEY_DATA_MODIFIERS (returned_value, modifiers);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1496 invalid_argument ("Unknown key-sequence specifier",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 /* Used by character-to-event */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 int allow_menu_events)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1506 Lisp_Key_Data raw_key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 if (allow_menu_events &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 CONSP (list) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 /* #### where the hell does this come from? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 EQ (XCAR (list), Qmenu_selection))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 Lisp_Object fn, arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 if (! NILP (Fcdr (Fcdr (list))))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1515 invalid_argument ("Invalid menu event desc", list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 arg = Fcar (Fcdr (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 if (SYMBOLP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 fn = Qcall_interactively;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 fn = Qeval;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1521 XSET_EVENT_TYPE (event, misc_user_event);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1522 XSET_EVENT_CHANNEL (event, wrap_frame (selected_frame ()));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1523 XSET_EVENT_MISC_USER_FUNCTION (event, fn);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1524 XSET_EVENT_MISC_USER_OBJECT (event, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 define_key_parser (list, &raw_key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1530 if (
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1531 #define INCLUDE_BUTTON_ZERO
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1532 #define FROB(num) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1533 EQ (raw_key.keysym, Qbutton##num) || \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1534 EQ (raw_key.keysym, Qbutton##num##up) ||
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1535 #include "keymap-buttons.h"
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1536 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1537 invalid_operation ("Mouse-clicks can't appear in saved keyboard macros",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1538 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1540 XSET_EVENT_CHANNEL (event, Vselected_console);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1541 XSET_EVENT_TYPE (event, key_press_event);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1542 XSET_EVENT_KEY_KEYSYM (event, raw_key.keysym);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1543 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (&raw_key));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 int
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1548 event_matches_key_specifier_p (Lisp_Object event, Lisp_Object key_specifier)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1550 Lisp_Object event2 = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 int retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1554 if (XEVENT_TYPE (event) != key_press_event || NILP (key_specifier) ||
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 /* if the specifier is an integer such as 27, then it should match
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1559 both of the events `escape' and `control ['. Calling
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1560 Fcharacter_to_event() will only match `escape'. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 if (CHAR_OR_CHAR_INTP (key_specifier))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 return (XCHAR_OR_CHAR_INT (key_specifier)
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
1563 == event_to_character (event, 0, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 /* Otherwise, we cannot call event_to_character() because we may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 be dealing with non-ASCII keystrokes. In any case, if I ask
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1567 for `control [' then I should get exactly that, and not
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1568 `escape'.
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1569
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1570 However, we have to behave differently on TTY's, where `control ['
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
1571 is silently converted into `escape' by the keyboard driver.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 In this case, ASCII is the only thing we know about, so we have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 to compare the ASCII values. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 GCPRO1 (event2);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1576 if (EVENTP (key_specifier))
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1577 event2 = Fcopy_event (key_specifier, Qnil);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1578 else
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1579 event2 = Fcharacter_to_event (key_specifier, Qnil, Qnil, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 if (XEVENT (event2)->event_type != key_press_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 retval = 0;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1582 else if (CONSOLE_TTY_P (XCONSOLE (XEVENT_CHANNEL (event))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 int ch1, ch2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
1586 ch1 = event_to_character (event, 0, 0);
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
1587 ch2 = event_to_character (event2, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 }
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1590 else if (EQ (XEVENT_KEY_KEYSYM (event), XEVENT_KEY_KEYSYM (event2)) &&
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1591 XEVENT_KEY_MODIFIERS (event) == XEVENT_KEY_MODIFIERS (event2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 retval = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 retval = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 Fdeallocate_event (event2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 static int
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1601 meta_prefix_char_p (const Lisp_Key_Data *key)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1603 Lisp_Object event = Fmake_event (Qnil, Qnil);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1604 struct gcpro gcpro1;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1605 int retval;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1606
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1607 GCPRO1 (event);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1608
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1609 XSET_EVENT_TYPE (event, key_press_event);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1610 XSET_EVENT_CHANNEL (event, Vselected_console);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1611 XSET_EVENT_KEY_KEYSYM (event, KEY_DATA_KEYSYM (key));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1612 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (key));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1613 retval = event_matches_key_specifier_p (event, Vmeta_prefix_char);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1614 UNGCPRO;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1615 return retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 Return non-nil if EVENT matches KEY-SPECIFIER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 This can be useful, e.g., to determine if the user pressed `help-char' or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 `quit-char'.
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1622
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1623 KEY-SPECIFIER can be a character, integer, a symbol, a list of modifiers
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1624 and symbols, or an event.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1625
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1626 What this actually happens is this:
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1627
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1628 \(1) Return no, if EVENT is not a key press event or if KEY-SPECIFIER is nil
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1629 or an integer that cannot be converted to a character.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1630
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1631 \(2) If KEY-SPECIFIER is a character or integer,
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1632 (event-to-character EVENT nil nil nil) is called, and the characters are
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1633 compared to get the result. The reason for special-casing this and doing
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1634 it this way is to ensure that, e.g., a KEY-SPECIFIER of 27 matches both
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1635 a key-press `escape' and a key-press `control ['. #### Think about META
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1636 argument to event-to-character.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1637
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1638 \(3) If KEY-SPECIFIER is an event, fine; else, convert to an event using
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1639 \(character-to-event KEY-SPECIFIER nil nil nil). If EVENT is not on a TTY,
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1640 we just compare keysyms and modifiers and return yes if both are equal.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1641 For TTY, we do character-level comparison by converting both to a character
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1642 with (event-to-character ... nil nil nil) and comparing the characters.
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1643
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 (event, key_specifier))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 CHECK_LIVE_EVENT (event);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1648 return (event_matches_key_specifier_p (event, key_specifier) ? Qt : Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 }
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1650 #define MACROLET(k, m) do { \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1651 SET_KEY_DATA_KEYSYM (returned_value, k); \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1652 SET_KEY_DATA_MODIFIERS (returned_value, m); \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
1653 RETURN_SANS_WARNINGS; \
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1654 } while (0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 /* ASCII grunge.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 Given a keysym, return another keysym/modifier pair which could be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 considered the same key in an ASCII world. Backspace returns ^H, for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 example.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 static void
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1661 define_key_alternate_name (Lisp_Key_Data *key,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1662 Lisp_Key_Data *returned_value)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1664 Lisp_Object keysym = KEY_DATA_KEYSYM (key);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1665 int modifiers = KEY_DATA_MODIFIERS (key);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1666 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1667 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META));
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1668 SET_KEY_DATA_KEYSYM (returned_value, Qnil); /* By default, no "alternate" key */
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1669 SET_KEY_DATA_MODIFIERS (returned_value, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1670 if (modifiers_sans_meta == XEMACS_MOD_CONTROL)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 {
722
218e3d55692e [xemacs-hg @ 2002-01-04 05:16:01 by stephent]
stephent
parents: 665
diff changeset
1672 if (EQ (keysym, QKspace))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 MACROLET (make_char ('@'), modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 else if (!CHARP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 else switch (XCHAR (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 case '@': /* c-@ => c-space */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 MACROLET (QKspace, modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 case 'h': /* c-h => backspace */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 MACROLET (QKbackspace, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 case 'i': /* c-i => tab */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 MACROLET (QKtab, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 case 'j': /* c-j => linefeed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 MACROLET (QKlinefeed, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 case 'm': /* c-m => return */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 MACROLET (QKreturn, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 case '[': /* c-[ => escape */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 MACROLET (QKescape, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 else if (modifiers_sans_meta != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1697 MACROLET (make_char ('h'), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 else if (EQ (keysym, QKtab)) /* tab => c-i */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1699 MACROLET (make_char ('i'), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1701 MACROLET (make_char ('j'), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 else if (EQ (keysym, QKreturn)) /* return => c-m */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1703 MACROLET (make_char ('m'), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 else if (EQ (keysym, QKescape)) /* escape => c-[ */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1705 MACROLET (make_char ('['), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 #undef MACROLET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 Lisp_Object keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 Lisp_Object new_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 Lisp_Object mpc_binding;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1719 Lisp_Key_Data meta_key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 if (NILP (Vmeta_prefix_char) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 define_key_parser (Vmeta_prefix_char, &meta_key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 if (indx == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 new_keys = keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 else if (STRINGP (keys))
5089
99f8ebc082d9 Make #'substring an alias of #'subseq; give the latter the byte code.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5050
diff changeset
1732 new_keys = Fsubseq (keys, Qzero, make_int (indx));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 else if (VECTORP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 new_keys = make_vector (indx, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 for (i = 0; i < indx; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1740 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1741 new_keys = Qnil;
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2421
diff changeset
1742 ABORT ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1743 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 if (EQ (keys, new_keys))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1746 signal_ferror_with_frob (Qinvalid_operation, mpc_binding,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1747 "can't bind %s: %s has a non-keymap binding",
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1748 (CIbyte *) XSTRING_DATA (Fkey_description (keys)),
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1749 (CIbyte *) XSTRING_DATA (Fsingle_key_description
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1750 (Vmeta_prefix_char)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1752 signal_ferror_with_frob (Qinvalid_operation, mpc_binding,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1753 "can't bind %s: %s %s has a non-keymap binding",
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1754 (CIbyte *) XSTRING_DATA (Fkey_description (keys)),
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1755 (CIbyte *) XSTRING_DATA (Fkey_description
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1756 (new_keys)),
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1757 (CIbyte *) XSTRING_DATA (Fsingle_key_description
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
1758 (Vmeta_prefix_char)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 Define key sequence KEYS, in KEYMAP, as DEF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 KEYMAP is a keymap object.
3086
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1764 KEYS is the key sequence to bind, described below.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 DEF is anything that can be a key's definition:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 nil (means key is undefined in this keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 a command (a Lisp function suitable for interactive calling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 a string or key sequence vector (treated as a keyboard macro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 a keymap (to define a prefix key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 a symbol; when the key is looked up, the symbol will stand for its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 function definition, that should at that time be one of the above,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 or another symbol whose function definition is used, and so on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 a cons (STRING . DEFN), meaning that DEFN is the definition
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 (DEFN should be a valid definition in its own right);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776
3086
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1777 A `key sequence' is a vector of one or more keystrokes.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1778 A `keystroke' is a list containing a key and zero or more modifiers. The
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1779 key must be the last element of the list.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1780 A `key' is a symbol corresponding to a key on the keyboard, or to a mouse
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1781 gesture. Mouse clicks are denoted by symbols prefixed with "button",
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1782 followed by a digit for which button, and optionally "up". Thus `button1'
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1783 means the down-stroke and `button1up' means the up-stroke when clicking
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1784 mouse button 1.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1785 A `modifier' is a symbol naming a physical key which is only "noticed" by
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1786 XEmacs when chorded with another key. The `shift' modifier is a special
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1787 case. You cannot use `(meta shift a)' to mean `(meta A)', since for
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1788 characters that have ASCII equivalents, the state of the shift key is
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1789 implicit in the keysym (a vs. A). You also cannot say `(shift =)' to mean
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1790 `+', as that correspondence varies from keyboard to keyboard. The shift
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1791 modifier can only be applied to keys that do not have a second keysym on the
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1792 same key, such as `backspace' and `tab'. A mouse click may be combined with
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1793 modifiers to create a compound "keystroke".
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1794
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1795 The keys, mouse gestures, and modifiers that are available depend on your
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1796 console and its driver. At a minimum the ASCII graphic characters will be
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1797 available as keys, and shift, control, and meta as modifiers.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1798
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1799 To find out programmatically what a key is bound to, use `key-binding' to
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1800 check all applicable keymaps, or `lookup-key' to check a specific keymap.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1801 The documentation for `key-binding' also contains a description of which
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1802 keymaps are applicable in various situations. `where-is-internal' does
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1803 the opposite of `key-binding', i.e. searches keymaps for the keys that
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1804 map to a particular binding.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1805
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1806 If you are confused about why a particular key sequence is generating a
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1807 particular binding, and looking through the keymaps doesn't help, setting
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1808 the variable `debug-emacs-events' may help. If not, try checking
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1809 what's in `function-key-map' and `key-translation-map'.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1810
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1811 When running under a window system, typically the repertoire of keys is
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1812 vastly expanded. XEmacs does its best to use the names defined on each
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1813 platform. Also, when running under a window system, XEmacs can tell the
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1814 difference between the keystrokes control-h, control-shift-h, and backspace.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1815 If the symbols differ, you can bind different actions to each. For mouse
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1816 clicks, different commands may be bound to the up and down strokes, though
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1817 that is probably not what you want, so be careful.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1818
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1819 Variant representations:
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1820
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1821 Besides the canonical representation as a vector of lists of symbols,
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1822 `define-key' also accepts a number of abbreviations, aliases, and variants
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1823 for convenience, compatibility, and internal use.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1824
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1825 A keystroke may be represented by a key; this is treated as though it were a
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1826 list containing that key as the only element. A keystroke may also be
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1827 represented by an event object, as returned by the `next-command-event' and
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1828 `read-key-sequence' functions. A key sequence may be represented by a
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1829 single keystroke; this is treated as a vector containing that keystroke as
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1830 its only element.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1831
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1832 A key may be represented by a character or its equivalent integer code,
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1833 if and only if it is equivalent to a character with a code in the range
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1834 32 - 255.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1835
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1836 For backward compatibility, a key sequence may also be represented by a
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1837 string. In this case, it represents the key sequence(s) that would
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1838 produce that sequence of ASCII characters in a purely ASCII world. An
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1839 alternative string representation is keyboard macro notation, which can
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1840 be translated to the canonical representation with `kbd'.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1841
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1842 Examples:
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1843
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1844 The key sequence `A' (which invokes `self-insert-command') is represented
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1845 by all of these forms:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 A ?A 65 (A) (?A) (65)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 [A] [?A] [65] [(A)] [(?A)] [(65)]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848
3086
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1849 The key sequence `control-a' is represented by these forms:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 (control A) (control ?A) (control 65)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 [(control A)] [(control ?A)] [(control 65)]
3086
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1852
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1853 The key sequence `control-c control-a' is represented by these forms:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 [(control c) (control a)] [(control ?c) (control ?a)]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 [(control 99) (control 65)] etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856
3086
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1857 The keystroke `control-b' *may not* be represented by the number 2 (the
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1858 ASCII code for ^B) or the character `?\^B'.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1859
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1860 The `break' key may be represented only by the symbol `break'.
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1861
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 Mouse button clicks work just like keypresses: (control button1) means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 pressing the left mouse button while holding down the control key.
3086
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1864
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1865 A string containing the ASCII backspace character, "\\^H", would represent
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1866 two key sequences: `(control h)' and `backspace'. Binding a
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 command to this will actually bind both of those key sequences. Likewise
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 for the following pairs:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 control h backspace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 control i tab
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 control m return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 control j linefeed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 control [ escape
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 control @ control space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 After binding a command to two key sequences with a form like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 (define-key global-map "\\^X\\^I" \'command-1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 it is possible to redefine only one of those sequences like so:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 (define-key global-map [(control x) (control i)] \'command-2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 (define-key global-map [(control x) tab] \'command-3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 (keymap, keys, def))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 int idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 int metized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 int ascii_hack;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 if (VECTORP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 len = XVECTOR_LENGTH (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 else if (STRINGP (keys))
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1898 len = string_char_length (keys);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 if (!CONSP (keys)) keys = list1 (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 len = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 keys = make_vector (1, keys); /* this is kinda sleazy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 keys = wrong_type_argument (Qsequencep, keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 len = XINT (Flength (keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 if (len == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 GCPRO3 (keymap, keys, def);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 /* ASCII grunge.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 When the user defines a key which, in a strictly ASCII world, would be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 produced by two different keys (^J and linefeed, or ^H and backspace,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 for example) then the binding will be made for both keysyms.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 This is done if the user binds a command to a string, as in
3086
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1921 (define-key map "\^H" 'something), but not when using the canonical
c6ef6267f65c [xemacs-hg @ 2005-11-22 10:36:34 by stephent]
stephent
parents: 3025
diff changeset
1922 syntax (define-key map '(control h) 'something).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 ascii_hack = (STRINGP (keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 idx = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 Lisp_Object c;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1932 Lisp_Key_Data raw_key1;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
1933 Lisp_Key_Data raw_key2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 if (STRINGP (keys))
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1935 c = make_char (string_ichar (keys, idx));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 c = XVECTOR_DATA (keys) [idx];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 define_key_parser (c, &raw_key1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 if (idx == (len - 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 /* This is a hack to prevent a binding for the meta-prefix-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 from being made in a map which already has a non-empty "meta"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 submap. That is, we can't let both "escape" and "meta" have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 a binding in the same keymap. This implies that the idiom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 (define-key my-map "\e" my-escape-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 (define-key my-escape-map "a" 'my-command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 no longer works. That's ok. Instead the luser should do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 (define-key my-map "\ea" 'my-command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 or, more correctly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 (define-key my-map "\M-a" 'my-command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 and then perhaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 (defvar my-escape-map (lookup-key my-map "\e"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 if the luser really wants the map in a variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1959 Lisp_Object meta_map;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 NGCPRO1 (c);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1963 meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1964 XKEYMAP (keymap)->table, Qnil);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1965 if (!NILP (meta_map)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1966 && keymap_fullness (meta_map) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1967 invalid_operation_2
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1968 ("Map contains meta-bindings, can't bind",
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1969 Fsingle_key_description (Vmeta_prefix_char), keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 metized = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 if (ascii_hack)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 define_key_alternate_name (&raw_key1, &raw_key2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 raw_key2.keysym = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 raw_key2.modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 if (metized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1990 raw_key1.modifiers |= XEMACS_MOD_META;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1991 raw_key2.modifiers |= XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 metized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 /* This crap is to make sure that someone doesn't bind something like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1997 if (raw_key1.modifiers & XEMACS_MOD_META)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 if (++idx == len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 keymap_store (keymap, &raw_key1, def);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 if (ascii_hack && !NILP (raw_key2.keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 keymap_store (keymap, &raw_key2, def);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 return def;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 Lisp_Object cmd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 NGCPRO1 (c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 if (NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 cmd = Fmake_sparse_keymap (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 XKEYMAP (cmd)->name /* for debugging */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 = list2 (make_key_description (&raw_key1, 1), keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 keymap_store (keymap, &raw_key1, cmd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 if (NILP (Fkeymapp (cmd)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
2023 sferror_2 ("Invalid prefix keys in sequence",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 c, keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 if (ascii_hack && !NILP (raw_key2.keysym) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 keymap_store (keymap, &raw_key2, cmd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 keymap = get_keymap (cmd, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 /* Looking up keys in keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 /* We need a very fast (i.e., non-consing) version of lookup-key in order
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 to make where-is-internal really fly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 struct raw_lookup_key_mapper_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 int remaining;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2047 const Lisp_Key_Data *raw_keys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 int raw_keys_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 int keys_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 int accept_default;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 /* Caller should gc-protect args (keymaps may autoload) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 raw_lookup_key (Lisp_Object keymap,
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2058 const Lisp_Key_Data *raw_keys, int raw_keys_count,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 int keys_so_far, int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 struct raw_lookup_key_mapper_closure c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 c.remaining = raw_keys_count - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 c.raw_keys = raw_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 c.raw_keys_count = raw_keys_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 c.keys_so_far = keys_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 c.accept_default = accept_default;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 raw_lookup_key_mapper (Lisp_Object k, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 struct raw_lookup_key_mapper_closure *c =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 (struct raw_lookup_key_mapper_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 int accept_default = c->accept_default;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 int remaining = c->remaining;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 int keys_so_far = c->keys_so_far;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2081 const Lisp_Key_Data *raw_keys = c->raw_keys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 Lisp_Object cmd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 if (! meta_prefix_char_p (&(raw_keys[0])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 /* Normal case: every case except the meta-hack (see below). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 if (remaining == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 /* Return whatever we found if we're out of keys */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 else if (NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 /* Found nothing (though perhaps parent map may have binding) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 else if (NILP (Fkeymapp (cmd)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 /* Didn't find a keymap, and we have more keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 * Return a fixnum to indicate that keys were too long.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 cmd = make_int (keys_so_far + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 keys_so_far + 1, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 /* This is a hack so that looking up a key-sequence whose last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 * element is the meta-prefix-char will return the keymap that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 * the "meta" keys are stored in, if there is no binding for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 * the meta-prefix-char (and if this map has a "meta" submap).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 * If this map doesn't have a "meta" submap, then the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 * meta-prefix-char is looked up just like any other key.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 if (remaining == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 /* First look for the prefix-char directly */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 if (NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 /* Do kludgy return of the meta-map */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2120 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 XKEYMAP (k)->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 /* Search for the prefix-char-prefixed sequence directly */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 cmd = get_keymap (cmd, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 if (!NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 keys_so_far + 1, accept_default);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2132 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2134 Lisp_Key_Data metified;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 metified.keysym = raw_keys[1].keysym;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2136 metified.modifiers = raw_keys[1].modifiers |
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2137 (unsigned char) XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 /* Search for meta-next-char sequence directly */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 cmd = keymap_lookup_1 (k, &metified, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 if (remaining == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 cmd = get_keymap (cmd, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 if (!NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 keys_so_far + 2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 if (accept_default && NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 cmd = XKEYMAP (k)->default_binding;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 return cmd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 /* Caller should gc-protect arguments */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 /* This function can GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2166 Lisp_Key_Data kkk[20];
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2167 Lisp_Key_Data *raw_keys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 if (nkeys == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2173 if (nkeys < countof (kkk))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 raw_keys = kkk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 else
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2176 raw_keys = alloca_array (Lisp_Key_Data, nkeys);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 for (i = 0; i < nkeys; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 define_key_parser (keys[i], &(raw_keys[i]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 /* This function can GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2190 Lisp_Key_Data kkk[20];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 int nkeys;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2194 Lisp_Key_Data *raw_keys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 Lisp_Object tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 int iii;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 CHECK_LIVE_EVENT (event_head);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 nkeys = event_chain_count (event_head);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2203 if (nkeys < countof (kkk))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 raw_keys = kkk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 else
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2206 raw_keys = alloca_array (Lisp_Key_Data, nkeys);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 nkeys = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 EVENT_CHAIN_LOOP (event, event_head)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 define_key_parser (event, &(raw_keys[nkeys++]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 GCPRO2 (keymaps[0], event_head);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 gcpro1.nvars = nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 for (iii = 0; iii < nmaps; iii++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 /* Too long in some local map means don't look at global map */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 else if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 Nil is returned if KEYS is unbound. See documentation of `define-key'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 for valid key definitions and key-sequence specifications.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 A number is returned if KEYS is "too long"; that is, the leading
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 characters fail to be a valid sequence of prefix characters in KEYMAP.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2238 The number is how many key strokes at the front of KEYS it takes to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2239 reach a non-prefix command.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 (keymap, keys, accept_default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 if (VECTORP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 return lookup_keys (keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 XVECTOR_LENGTH (keys),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 XVECTOR_DATA (keys),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 !NILP (accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 else if (STRINGP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
2253 int length = string_char_length (keys);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 int i;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2255 Lisp_Key_Data *raw_keys = alloca_array (Lisp_Key_Data, length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 if (length == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 for (i = 0; i < length; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2261 Ichar n = string_ichar (keys, i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 define_key_parser (make_char (n), &(raw_keys[i]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 return raw_lookup_key (keymap, raw_keys, length, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 !NILP (accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 keys = wrong_type_argument (Qsequencep, keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 return Flookup_key (keymap, keys, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 /* Given a key sequence, returns a list of keymaps to search for bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 Does all manner of semi-hairy heuristics, like looking in the current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 buffer's map before looking in the global map and looking in the local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 map of the buffer in which the mouse was clicked in event0 is a click.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 It would be kind of nice if this were in Lisp so that this semi-hairy
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 semi-heuristic command-lookup behavior could be readily understood and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 customised. However, this needs to be pretty fast, or performance of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 keyboard macros goes to shit; putting this in lisp slows macros down
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 2-3x. And they're already slower than v18 by 5-6x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 struct relevant_maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 int nmaps;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
2289 int max_maps;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 Lisp_Object *maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 struct gcpro *gcpro;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 static void get_relevant_extent_keymaps (Lisp_Object pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 Lisp_Object buffer_or_string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 Lisp_Object glyph,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 struct relevant_maps *closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 static void get_relevant_minor_maps (Lisp_Object buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 struct relevant_maps *closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
2304 int nmaps = closure->nmaps;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 if (!KEYMAPP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 closure->nmaps = nmaps + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 if (nmaps < closure->max_maps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 closure->maps[nmaps] = map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 closure->gcpro->nvars = nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 get_relevant_keymaps (Lisp_Object keys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 int max_maps, Lisp_Object maps[])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 Lisp_Object terminal = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 struct relevant_maps closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 struct console *con;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 GCPRO1 (*maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 gcpro1.nvars = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 closure.nmaps = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 closure.max_maps = max_maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 closure.maps = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 closure.gcpro = &gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 if (EVENTP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 terminal = event_chain_tail (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 else if (VECTORP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 int len = XVECTOR_LENGTH (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 if (len > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 terminal = XVECTOR_DATA (keys)[len - 1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 if (EVENTP (terminal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 CHECK_LIVE_EVENT (terminal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 con = event_console_or_selected (terminal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 con = XCONSOLE (Vselected_console);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 if (KEYMAPP (con->overriding_terminal_local_map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 || KEYMAPP (Voverriding_local_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 if (KEYMAPP (con->overriding_terminal_local_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 relevant_map_push (con->overriding_terminal_local_map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 if (KEYMAPP (Voverriding_local_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 relevant_map_push (Voverriding_local_map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 else if (!EVENTP (terminal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 || (XEVENT (terminal)->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 && XEVENT (terminal)->event_type != button_release_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
2362 Lisp_Object tem = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
2363
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 /* It's not a mouse event; order of keymaps searched is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 o keymap of any/all extents under the mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 o minor-mode maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 o local-map of current-buffer
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2368 o global-tty-map or global-window-system-map
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 o global-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 /* The terminal element of the lookup may be nil or a keysym.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 In those cases we don't want to check for an extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 keymap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 if (EVENTP (terminal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 tem, Qnil, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 get_relevant_minor_maps (tem, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 tem = current_buffer->keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 relevant_map_push (tem, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 #ifdef HAVE_WINDOW_SYSTEM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 /* It's a mouse event; order of keymaps searched is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 o vertical-divider-map, if event is over a divider
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 o local-map of mouse-grabbed-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 o keymap of any/all extents under the mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 if the mouse is over a modeline:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 o modeline-map of buffer corresponding to that modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 o else, local-map of buffer under the mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 o minor-mode maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 o local-map of current-buffer
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2397 o global-tty-map or global-window-system-map
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 o global-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 Lisp_Object window = Fevent_window (terminal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 if (KEYMAPP (Vvertical_divider_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 relevant_map_push (Vvertical_divider_map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 if (BUFFERP (Vmouse_grabbed_buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 if (!NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 relevant_map_push (map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 if (!NILP (window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 Lisp_Object buffer = Fwindow_buffer (window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 if (!NILP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 if (!NILP (Fevent_over_modeline_p (terminal)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 get_relevant_extent_keymaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 (Fevent_modeline_position (terminal),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 XBUFFER (buffer)->generated_modeline_string,
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2431 Fevent_glyph_extent (terminal), &closure);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 if (!UNBOUNDP (map) && !NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 relevant_map_push (get_keymap (map, 1, 1), &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 Fevent_glyph_extent (terminal),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 Lisp_Object map = XBUFFER (buffer)->keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 get_relevant_minor_maps (buffer, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 if (!NILP(map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 relevant_map_push (map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 else if (!NILP (Fevent_over_toolbar_p (terminal)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 if (!UNBOUNDP (map) && !NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 relevant_map_push (map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 #endif /* HAVE_WINDOW_SYSTEM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2463 if (CONSOLE_TTY_P (con))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2464 relevant_map_push (Vglobal_tty_map, &closure);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2465 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2466 relevant_map_push (Vglobal_window_system_map, &closure);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2467
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 int nmaps = closure.nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 /* Silently truncate at 100 keymaps to prevent infinite lossage */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 if (nmaps >= max_maps && max_maps > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 maps[max_maps - 1] = Vcurrent_global_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 maps[nmaps] = Vcurrent_global_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 return nmaps + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 /* Returns a set of keymaps extracted from the extents at POS in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 to look for a keymap in, and if it has one, its keymap will be the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 first element in the list returned. This is so we can correctly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 search the keymaps associated with glyphs which may be physically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 disjoint from their extents: for example, if a glyph is out in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 margin, we should still consult the keymap of that glyph's extent,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 which may not itself be under the mouse.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 Lisp_Object glyph,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 struct relevant_maps *closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 /* the glyph keymap, if any, comes first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 (Processing it twice is no big deal: noop.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 if (!NILP (glyph))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 if (!NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 relevant_map_push (get_keymap (keymap, 1, 1), closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 /* Next check the extents at the text position, if any */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 if (!NILP (pos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 Lisp_Object extent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 !NILP (extent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 if (!NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 relevant_map_push (get_keymap (keymap, 1, 1), closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 if (CONSP (assoc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 Lisp_Object sym = XCAR (assoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 if (SYMBOLP (sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 if (!NILP (val) && !UNBOUNDP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
2533 return get_keymap (XCDR (assoc), 0, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 Lisp_Object alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 /* Will you ever lose badly if you make this circular! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 CONSP (alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 alist = XCDR (alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 if (!NILP (m)) relevant_map_push (m, closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 /* #### Would map-current-keymaps be a better thing?? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 Return a list of the current keymaps that will be searched for bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 This lists keymaps such as the current local map and the minor-mode maps,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 but does not list the parents of those keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 EVENT-OR-KEYS controls which keymaps will be listed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 mouse event), the keymaps for that mouse event will be listed (see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 `key-binding'). Otherwise, the keymaps for key presses will be listed.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2567 See `key-binding' for a description of which keymaps are searched in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2568 various situations.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 (event_or_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 Lisp_Object *gubbish = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 GCPRO1 (event_or_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 gubbish = alloca_array (Lisp_Object, nmaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 return Flist (nmaps, gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 Return the binding for command KEYS in current keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 KEYS is a string, a vector of events, or a vector of key-description lists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 as described in the documentation for the `define-key' function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 The binding is probably a symbol with a function definition; see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 the documentation for `lookup-key' for more information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 For key-presses, the order of keymaps searched is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 - the `keymap' property of any extent(s) at point;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 - any applicable minor-mode maps;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2600 - the current local map of the current-buffer;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2601 - either `global-tty-map' or `global-window-system-map', depending on
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2602 whether the current console is a TTY or non-TTY console;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 - the current global map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 For mouse-clicks, the order of keymaps searched is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 - the current-local-map of the `mouse-grabbed-buffer' if any;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 - vertical-divider-map, if the event happened over a vertical divider
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 - the `keymap' property of any extent(s) at the position of the click
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 (this includes modeline extents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 - the modeline-map of the buffer corresponding to the modeline under
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 the mouse (if the click happened over a modeline);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2612 - the value of `toolbar-map' in the current-buffer (if the click
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 happened over a toolbar);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2614 - the current local map of the buffer under the mouse (does not
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 apply to toolbar clicks);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616 - any applicable minor-mode maps;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2617 - either `global-tty-map' or `global-window-system-map', depending on
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2618 whether the current console is a TTY or non-TTY console;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 - the current global map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 Note that if `overriding-local-map' or `overriding-terminal-local-map'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 is non-nil, *only* those two maps and the current global map are searched.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2623
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2624 Note also that key sequences actually received from the keyboard driver
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2625 may be processed in various ways to generate the key sequence that is
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2626 actually looked up in the keymaps. In particular:
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2627
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2628 -- Keysyms are individually passed through `keyboard-translate-table' before
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2629 any other processing.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2630 -- After this, key sequences as a whole are passed through
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2631 `key-translation-map'.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2632 -- The resulting key sequence is actually looked up in the keymaps.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2633 -- If there's no binding found, the key sequence is passed through
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2634 `function-key-map' and looked up again.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2635 -- If no binding is found and `retry-undefined-key-binding-unshifted' is
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2636 set (it usually is) and the final keysym is an uppercase character,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2637 we lowercase it and start over from the `key-translation-map' stage.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2638 -- If no binding is found and we're on MS Windows and have international
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2639 support, we successively remap the key sequence using the keyboard layouts
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2640 of various default locales (current language environment, user default,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2641 system default, US ASCII) and try again. This makes (e.g.) sequences
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2642 such as `C-x b' work in a Russian locale, where the alphabetic keys are
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2643 actually generating Russian characters and not the Roman letters written
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2644 on the keycaps. (Not yet implemented)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2645 -- Finally, if the last keystroke matches `help-char', we automatically
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2646 generate and display a list of possible key sequences and bindings
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
2647 given the prefix so far generated.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 (keys, accept_default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 if (EVENTP (keys)) /* unadvertised "feature" for the future */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 for (i = 0; i < nmaps; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 Lisp_Object tem = Flookup_key (maps[i], keys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 /* Too long in some local map means don't look at global map */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 else if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 process_event_binding_result (Lisp_Object result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 if (EQ (result, Qundefined))
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
2684 /* The suppress-keymap function binds keys to `undefined' - special-case
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 that here, so that being bound to that has the same error-behavior as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 not being defined at all.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 Lisp_Object map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 /* Snap out possible keymap indirections */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 map = get_keymap (result, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 if (!NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 result = map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 /* Attempts to find a command corresponding to the event-sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 whose head is event0 (sequence is threaded though event_next).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 The return value will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 -- nil (there is no binding; this will also be returned
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 whenever the event chain is "too long", i.e. there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 is a non-nil, non-keymap binding for a prefix of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 the event chain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 -- a keymap (part of a command has been specified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 -- a command (anything that satisfies `commandp'; this includes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 some symbols, lists, subrs, strings, vectors, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 compiled-function objects) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 event_binding (Lisp_Object event0, int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 assert (EVENTP (event0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 nmaps = countof (maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 return process_event_binding_result (lookup_events (event0, nmaps, maps,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 /* like event_binding, but specify a keymap to search */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 if (!KEYMAPP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 return process_event_binding_result (lookup_events (event0, 1, &keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 /* Attempts to find a function key mapping corresponding to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 event-sequence whose head is event0 (sequence is threaded through
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 event_next). The return value will be the same as for event_binding(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 munging_key_map_event_binding (Lisp_Object event0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 enum munge_me_out_the_door munge)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 Vkey_translation_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 if (NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 /* Setting/querying the global and local maps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 Select KEYMAP as the global keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 Vcurrent_global_map = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 Select KEYMAP as the local keymap in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 If KEYMAP is nil, that means no local keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 (keymap, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 struct buffer *b = decode_buffer (buffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 if (!NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 b->keymap = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 Return BUFFER's local keymap, or nil if it has none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 struct buffer *b = decode_buffer (buffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 return b->keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 Return the current global keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 return Vcurrent_global_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 /* Mapping over keymap elements */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 prefix key, it's not entirely obvious what map-keymap should do, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 what it does is: map over all keys in this map; then recursively map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 over all submaps of this map that are "bucky" submaps. This means that,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 when mapping over a keymap, it appears that "x" and "C-x" are in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 same map, although "C-x" is really in the "control" submap of this one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 However, since we don't recursively descend the submaps that are bound
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 those explicitly, if that's what they want.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 So the end result of this is that the bucky keymaps (the ones indexed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 invisible from elisp. They're just an implementation detail that code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 outside of this file doesn't need to know about.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 struct map_keymap_unsorted_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2834 void (*fn) (const Lisp_Key_Data *, Lisp_Object binding, void *arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 void *arg;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2836 int modifiers;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 /* used by map_keymap() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 void *map_keymap_unsorted_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 struct map_keymap_unsorted_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2847 int modifiers = closure->modifiers;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2848 int mod_bit;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 if (mod_bit != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 int omod = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 closure->modifiers = (modifiers | mod_bit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 value = get_keymap (value, 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 elisp_maphash (map_keymap_unsorted_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 XKEYMAP (value)->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 map_keymap_unsorted_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 closure->modifiers = omod;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2862 Lisp_Key_Data key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 key.keysym = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 key.modifiers = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 ((*closure->fn) (&key, value, closure->arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871 struct map_keymap_sorted_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 Lisp_Object *result_locative;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 /* used by map_keymap_sorted() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 void *map_keymap_sorted_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 struct map_keymap_sorted_closure *cl =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 Lisp_Object *list = cl->result_locative;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 *list = Fcons (Fcons (key, value), *list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 and keymap_submaps().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2892 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2027
diff changeset
2894 Lisp_Object UNUSED (pred))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2898 int bit1, bit2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899 int sym1_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 int sym2_p = 0;
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
2901 extern Lisp_Object Qcharacter_of_keysym;
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
2902
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 obj1 = XCAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 obj2 = XCAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906 if (EQ (obj1, obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
2911 /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 that code instead of alphabetically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 if (! bit1 && SYMBOLP (obj1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 {
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
2916 Lisp_Object code = Fget (obj1, Qcharacter_of_keysym, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917 if (CHAR_OR_CHAR_INTP (code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 obj1 = code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 CHECK_CHAR_COERCE_INT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 sym1_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 if (! bit2 && SYMBOLP (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 {
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
2926 Lisp_Object code = Fget (obj2, Qcharacter_of_keysym, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 if (CHAR_OR_CHAR_INTP (code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 obj2 = code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 CHECK_CHAR_COERCE_INT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 sym2_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 if (XTYPE (obj1) != XTYPE (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 return SYMBOLP (obj2) ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 int o1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 int o2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 if (o1 == o2 && /* If one started out as a symbol and the */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 return sym2_p ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 return o1 < o2 ? 1 : -1; /* else just compare them */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 /* else they're both symbols. If they're both buckys, then order them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 if (bit1 && bit2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 return bit1 < bit2 ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 /* if only one is a bucky, then it comes later */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 if (bit1 || bit2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 return bit2 ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 /* otherwise, string-sort them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2960 Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2961 Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
2962 return 0 > qxestrcmp (s1, s2) ? 1 : -1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 /* used by map_keymap() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969 map_keymap_sorted (Lisp_Object keymap_table,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2970 int modifiers,
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2971 void (*function) (const Lisp_Key_Data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 Lisp_Object binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 void *map_keymap_sorted_closure),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 void *map_keymap_sorted_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 Lisp_Object contents = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 if (XINT (Fhash_table_count (keymap_table)) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 GCPRO1 (contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 struct map_keymap_sorted_closure c1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 c1.result_locative = &contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 for (; !NILP (contents); contents = XCDR (contents))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 Lisp_Object keysym = XCAR (XCAR (contents));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 Lisp_Object binding = XCDR (XCAR (contents));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2995 int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 if (sub_bits != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 map_keymap_sorted (XKEYMAP (get_keymap (binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 1, 1))->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 (modifiers | sub_bits),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 map_keymap_sorted_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3004 Lisp_Key_Data k;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 k.keysym = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 k.modifiers = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 ((*function) (&k, binding, map_keymap_sorted_closure));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 /* used by Fmap_keymap() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 static void
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3016 map_keymap_mapper (const Lisp_Key_Data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 Lisp_Object binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 void *function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 Lisp_Object fn;
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3022 fn = GET_LISP_FROM_VOID (function);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 call2 (fn, make_key_description (key, 1), binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 map_keymap (Lisp_Object keymap_table, int sort_first,
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3029 void (*function) (const Lisp_Key_Data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 Lisp_Object binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 void *fn_arg),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 void *fn_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 if (sort_first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 map_keymap_sorted (keymap_table, 0, function, fn_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 map_keymap_unsorted_closure.fn = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 map_keymap_unsorted_closure.arg = fn_arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 map_keymap_unsorted_closure.modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 &map_keymap_unsorted_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 Apply FUNCTION to each element of KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 FUNCTION will be called with two arguments: a key-description list, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 the binding. The order in which the elements of the keymap are passed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 the function is unspecified. If the function inserts new elements into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 the keymap, it may or may not be called with them later. No element of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 the keymap will ever be passed to the function more than once.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 The function will not be called on elements of this keymap's parents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 \(see the function `keymap-parents') or upon keymaps which are contained
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 within this keymap (multi-character definitions).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 It will be called on "meta" characters since they are not really
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 two-character sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 If the optional third argument SORT-FIRST is non-nil, then the elements of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 the keymap will be passed to the mapper function in a canonical order.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 Otherwise, they will be passed in hash (that is, random) order, which is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 faster.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 (function, keymap, sort_first))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 /* This function can GC */
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
3070 struct gcpro gcpro1, gcpro2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 /* tolerate obviously transposed args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 if (!NILP (Fkeymapp (function)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 Lisp_Object tmp = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 function = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 keymap = tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 }
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
3079 GCPRO2 (function, keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 keymap = get_keymap (keymap, 1, 1);
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
3081 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
5013
ae48681c47fa changes to VOID_TO_LISP et al.
Ben Wing <ben@xemacs.org>
parents: 4976
diff changeset
3082 map_keymap_mapper, STORE_LISP_IN_VOID (function));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 /* Accessible keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 struct accessible_keymaps_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3101 int modifiers,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 struct accessible_keymaps_closure *closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3105 int subbits = MODIFIER_HASH_KEY_BITS (keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 if (subbits != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 Lisp_Object submaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 contents = get_keymap (contents, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 submaps = keymap_submaps (contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 for (; !NILP (submaps); submaps = XCDR (submaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 XCDR (XCAR (submaps)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 (subbits | modifiers),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 Lisp_Object cmd = get_keyelt (contents, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 Lisp_Object vec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 int j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 int len;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3128 Lisp_Key_Data key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 key.keysym = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 key.modifiers = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131
5050
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
3132 assert (!NILP (cmd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 cmd = get_keymap (cmd, 0, 1);
5050
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
3134 assert (KEYMAPP (cmd));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 len = XVECTOR_LENGTH (thisseq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 for (j = 0; j < len; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 struct accessible_keymaps_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 (struct accessible_keymaps_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153 Lisp_Object submaps = keymap_submaps (thismap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 for (; !NILP (submaps); submaps = XCDR (submaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 XCDR (XCAR (submaps)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 Find all keymaps accessible via prefix characters from KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 Returns a list of elements of the form (KEYS . MAP), where the sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 An optional argument PREFIX, if non-nil, should be a key sequence;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 then the value includes only maps for prefixes that start with PREFIX.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 (keymap, prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 Lisp_Object accessible_keymaps = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 struct accessible_keymaps_closure c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 c.tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3183 keymap = get_keymap (keymap, 1, 1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3184
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 if (NILP (prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3188 prefix = make_vector (0, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3190 else if (VECTORP (prefix) || STRINGP (prefix))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 int len = XINT (Flength (prefix));
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3193 Lisp_Object def;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 Lisp_Object p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 int iii;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3198 if (len == 0)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3199 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3200 prefix = Qnil;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3201 goto retry;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3202 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3203
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3204 def = Flookup_key (keymap, prefix, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 def = get_keymap (def, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 if (!KEYMAPP (def))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 goto RETURN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 keymap = def;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 p = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 NGCPRO1 (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 for (iii = 0; iii < len; iii++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3214 Lisp_Key_Data key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 define_key_parser (Faref (prefix, make_int (iii)), &key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 prefix = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3221 else
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3222 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3223 prefix = wrong_type_argument (Qarrayp, prefix);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3224 goto retry;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3225 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 accessible_keymaps = list1 (Fcons (prefix, keymap));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3229 /* For each map in the list maps, look at any other maps it points
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3230 to and stick them at the end if they are not already in the list */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 for (c.tail = accessible_keymaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 !NILP (c.tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 c.tail = XCDR (c.tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 CHECK_KEYMAP (thismap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 traverse_keymaps (thismap, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 accessible_keymaps_keymap_mapper, &c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 RETURN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 return accessible_keymaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 /* Pretty descriptions of key sequences */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 Return a pretty description of key-sequence KEYS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 Control characters turn into "C-foo" sequences, meta into "M-foo",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 spaces are put between sequence elements, etc...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 || EVENTP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 return Fsingle_key_description (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 else if (VECTORP (keys) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 STRINGP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 Lisp_Object string = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 /* Lisp_Object sep = Qnil; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 int size = XINT (Flength (keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 for (i = 0; i < size; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 Lisp_Object s2 = Fsingle_key_description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 (STRINGP (keys)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3276 ? make_char (string_ichar (keys, i))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 : XVECTOR_DATA (keys)[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 if (i == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 string = s2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 {
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
3283 /* if (NILP (sep)) Lisp_Object sep = build_ascstring (" ") */;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 return string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 Return a pretty description of command character KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 Control characters turn into C-whatever, etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 This differs from `text-char-description' in that it returns a description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 of a key read from the user rather than a character from a buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 if (SYMBOLP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 key = Fcons (key, Qnil); /* sleaze sleaze */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3305 DECLARE_EISTRING_MALLOC (buf);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3306 Lisp_Object str;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3307
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 if (!EVENTP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3310 Lisp_Object event = Fmake_event (Qnil, Qnil);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3311 CHECK_CHAR_COERCE_INT (key);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
3312 character_to_event (XCHAR (key), XEVENT (event),
4780
2fd201d73a92 Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 4355
diff changeset
3313 XCONSOLE (Vselected_console),
2fd201d73a92 Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 4355
diff changeset
3314 high_bit_is_meta, 1);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3315 format_event_object (buf, event, 1);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
3316 Fdeallocate_event (event);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3317 }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3318 else
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3319 format_event_object (buf, key, 1);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3320 str = eimake_string (buf);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3321 eifree (buf);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3322 return str;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 if (CONSP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3327 DECLARE_EISTRING (bufp);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3328
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 LIST_LOOP (rest, key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 Lisp_Object keysym = XCAR (rest);
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3333 if (EQ (keysym, Qcontrol)) eicat_ascii (bufp, "C-");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3334 else if (EQ (keysym, Qctrl)) eicat_ascii (bufp, "C-");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3335 else if (EQ (keysym, Qmeta)) eicat_ascii (bufp, "M-");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3336 else if (EQ (keysym, Qsuper)) eicat_ascii (bufp, "S-");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3337 else if (EQ (keysym, Qhyper)) eicat_ascii (bufp, "H-");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3338 else if (EQ (keysym, Qalt)) eicat_ascii (bufp, "A-");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3339 else if (EQ (keysym, Qshift)) eicat_ascii (bufp, "Sh-");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 else if (CHAR_OR_CHAR_INTP (keysym))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3341 eicat_ch (bufp, XCHAR_OR_CHAR_INT (keysym));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 CHECK_SYMBOL (keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 #if 0 /* This is bogus */
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3346 if (EQ (keysym, QKlinefeed)) eicat_ascii (bufp, "LFD");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3347 else if (EQ (keysym, QKtab)) eicat_ascii (bufp, "TAB");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3348 else if (EQ (keysym, QKreturn)) eicat_ascii (bufp, "RET");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3349 else if (EQ (keysym, QKescape)) eicat_ascii (bufp, "ESC");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3350 else if (EQ (keysym, QKdelete)) eicat_ascii (bufp, "DEL");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3351 else if (EQ (keysym, QKspace)) eicat_ascii (bufp, "SPC");
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3352 else if (EQ (keysym, QKbackspace)) eicat_ascii (bufp, "BS");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 #endif
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3355 eicat_lstr (bufp, XSYMBOL (keysym)->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 if (!NILP (XCDR (rest)))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3357 invalid_argument ("Invalid key description", key);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3360 return eimake_string (bufp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 return Fsingle_key_description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 (wrong_type_argument (intern ("char-or-event-p"), key));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 Return a pretty description of file-character CHR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 Unprintable characters turn into "^char" or \\NNN, depending on the value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 of the `ctl-arrow' variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 This differs from `single-key-description' in that it returns a description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 of a character from a buffer rather than a key read from the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 (chr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3375 Ibyte buf[200];
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3376 Ibyte *p;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3377 Ichar c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 int ctl_p = !NILP (ctl_arrow);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3380 Ichar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 ? 256 : 160));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 if (EVENTP (chr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 {
2862
b95fe16005fd [xemacs-hg @ 2005-07-17 20:08:40 by aidan]
aidan
parents: 2828
diff changeset
3387 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 if (NILP (ch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389 return
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
3390 signal_continuable_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
3391 (Qinvalid_argument,
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
3392 "key has no character equivalent (that we know of)",
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
3393 Fcopy_event (chr, Qnil));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394 chr = ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 CHECK_CHAR_COERCE_INT (chr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 c = XCHAR (chr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 p = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402 if (c >= printable_min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3404 p += set_itext_ichar (p, c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 else if (c < 040 && ctl_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408 *p++ = '^';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 *p++ = c + 64; /* 'A' - 1 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 else if (c == 0177)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 *p++ = '^';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414 *p++ = '?';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 else if (c >= 0200 || c < 040)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 *p++ = '\\';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 /* !!#### This syntax is not readable. It will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 be interpreted as a 3-digit octal number rather
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 than a 7-digit octal number. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 if (c >= 0400)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 *p++ = '0' + ((c & 07000000) >> 18);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 *p++ = '0' + ((c & 0700000) >> 15);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 *p++ = '0' + ((c & 070000) >> 12);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428 *p++ = '0' + ((c & 07000) >> 9);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 *p++ = '0' + ((c & 0700) >> 6);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 *p++ = '0' + ((c & 0070) >> 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 *p++ = '0' + ((c & 0007));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
3437 p += set_itext_ichar (p, c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440 *p = 0;
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3441 return build_istring (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 /* where-is (mapping bindings to keys) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3451 Lisp_Object firstonly, Eistring *target_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 Return list of keys that invoke DEFINITION in KEYMAPS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 KEYMAPS can be either a keymap (meaning search in that keymap and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 current global keymap) or a list of keymaps (meaning search in exactly
3096
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3457 those keymaps and no others).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 the first key sequence found, rather than a list of all possible key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462
3096
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3463 Optional 4th argument NOINDIRECT is ignored. (GNU Emacs uses it to allow
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3464 searching for an indirect keymap by inhibiting following of indirections to
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3465 keymaps or slots, but XEmacs doesn't need it because keymaps are a type.)
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3466
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3467 If optional 5th argument EVENT-OR-KEYS is non-nil and KEYMAPS is nil,
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3468 search in the currently applicable maps for EVENT-OR-KEYS (this is
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3469 equivalent to specifying `(current-keymaps EVENT-OR-KEYS)' as the
5694c986bd92 [xemacs-hg @ 2005-11-26 13:20:21 by stephent]
stephent
parents: 3086
diff changeset
3470 argument to KEYMAPS).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 */
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2027
diff changeset
3472 (definition, keymaps, firstonly, UNUSED (noindirect), event_or_keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 Lisp_Object *gubbish = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 /* Get keymaps as an array */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 if (NILP (keymaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 gubbish = alloca_array (Lisp_Object, nmaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 else if (CONSP (keymaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 nmaps = XINT (Flength (keymaps));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 gubbish = alloca_array (Lisp_Object, nmaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 for (rest = keymaps, i = 0; !NILP (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 rest = XCDR (keymaps), i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 nmaps = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 gubbish[0] = get_keymap (keymaps, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 if (!EQ (gubbish[0], Vcurrent_global_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 gubbish[1] = Vcurrent_global_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 nmaps++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 /* This function is like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 (key-description (where-is-internal definition nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 except that it writes its output into a (char *) buffer that you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 provide; it doesn't cons (or allocate memory) at all, so it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 very fast. This is used by menubar.c.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 void
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3527 where_is_to_char (Lisp_Object definition, Eistring *buffer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 Lisp_Object *gubbish = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 /* Get keymaps as an array */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 gubbish = alloca_array (Lisp_Object, nmaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 where_is_internal (definition, maps, nmaps, Qt, buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 static Lisp_Object
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3547 raw_keys_to_keys (Lisp_Key_Data *keys, int count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 Lisp_Object result = make_vector (count, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 while (count--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 static void
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3557 format_raw_keys (Lisp_Key_Data *keys, int count, Eistring *buf)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 int i;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3560 Lisp_Object event = Fmake_event (Qnil, Qnil);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3561 XSET_EVENT_TYPE (event, key_press_event);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3562 XSET_EVENT_CHANNEL (event, Vselected_console);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 for (i = 0; i < count; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
3565 XSET_EVENT_KEY_KEYSYM (event, keys[i].keysym);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
3566 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (&keys[i]));
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3567 format_event_object (buf, event, 1);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3568 if (i < count - 1)
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3569 eicat_ascii (buf, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 }
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
3571 Fdeallocate_event (event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 /* definition is the thing to look for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 map is a keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577 shadow is an array of shadow_count keymaps; if there is a different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 binding in any of the keymaps of a key that we are considering
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 returning, then we reconsider.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 firstonly means give up after finding the first match;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 keys_so_far and modifiers_so_far describe which map we're looking in;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 then keys_so_far will be {(control x), \4}, and modifiers_so_far
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3584 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 beyond that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 (keys_so_far is a global buffer and the keys_count arg says how much
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 of it we're currently interested in.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 If target_buffer is provided, then we write a key-description into it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 to avoid consing a string. This only works with firstonly on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 struct where_is_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 Lisp_Object definition;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 Lisp_Object *shadow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 int shadow_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 int firstonly;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 int keys_count;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3602 int modifiers_so_far;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3603 Eistring *target_buffer;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3604 Lisp_Key_Data *keys_so_far;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 int keys_so_far_total_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 int keys_so_far_malloced;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 where_is_recursive_mapper (Lisp_Object map, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 struct where_is_closure *c = (struct where_is_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 Lisp_Object definition = c->definition;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3617 const int firstonly = c->firstonly;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3618 const int keys_count = c->keys_count;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3619 const int modifiers_so_far = c->modifiers_so_far;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3620 Eistring *target_buffer = c->target_buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 Lisp_Object keys = Fgethash (definition,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622 XKEYMAP (map)->inverse_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 Lisp_Object submaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 if (!NILP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 /* One or more keys in this map match the definition we're looking for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 Verify that these bindings aren't shadowed by other bindings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 in the shadow maps. Either nil or number as value from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 raw_lookup_key() means undefined. */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3633 Lisp_Key_Data *so_far = c->keys_so_far;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 for (;;) /* loop over all keys that match */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 so_far [keys_count].keysym = k;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3641 SET_KEY_DATA_MODIFIERS (&so_far [keys_count], modifiers_so_far);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 /* now loop over all shadow maps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644 for (i = 0; i < c->shadow_count; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 so_far,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 keys_count + 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 if (NILP (shadowed) || CHARP (shadowed) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 EQ (shadowed, definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 continue; /* we passed this test; it's not shadowed here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 /* ignore this key binding, since it actually has a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 different binding in a shadowing map */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 goto c_doesnt_have_proper_loop_exit_statements;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 /* OK, the key is for real */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 if (target_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 {
5050
6f2158fa75ed Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents: 5013
diff changeset
3663 assert (firstonly);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 format_raw_keys (so_far, keys_count + 1, target_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665 return make_int (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 else if (firstonly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 return raw_keys_to_keys (so_far, keys_count + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671 result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673 c_doesnt_have_proper_loop_exit_statements:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 /* now on to the next matching key ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 if (!CONSP (keys)) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 keys = XCDR (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 /* Now search the sub-keymaps of this map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 If we're in "firstonly" mode and have already found one, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 point is not reached. If we get one from lower down, either
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 return it immediately (in firstonly mode) or tack it onto the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 end of the ones we've gotten so far.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686 for (submaps = keymap_submaps (map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 !NILP (submaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 submaps = XCDR (submaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690 Lisp_Object key = XCAR (XCAR (submaps));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 Lisp_Object submap = XCDR (XCAR (submaps));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3692 int lower_modifiers;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 int lower_keys_count = keys_count;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3694 int bucky;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 submap = get_keymap (submap, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 if (EQ (submap, map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 /* Arrgh! Some loser has introduced a loop... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 /* If this is not a keymap, then that's probably because someone
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 did an `fset' of a symbol that used to point to a map such that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704 it no longer does. Sigh. Ignore this, and invalidate the cache
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705 so that it doesn't happen to us next time too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 if (NILP (submap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 XKEYMAP (map)->sub_maps_cache = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 /* If the map is a "bucky" map, then add a bit to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 modifiers_so_far list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 Otherwise, add a new raw_key onto the end of keys_so_far.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 bucky = MODIFIER_HASH_KEY_BITS (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 if (bucky != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 lower_modifiers = (modifiers_so_far | bucky);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3722 Lisp_Key_Data *so_far = c->keys_so_far;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723 lower_modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 so_far [lower_keys_count].keysym = key;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3725 SET_KEY_DATA_MODIFIERS (&so_far [lower_keys_count], modifiers_so_far);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 lower_keys_count++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 if (lower_keys_count >= c->keys_so_far_total_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 int size = lower_keys_count + 50;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 if (! c->keys_so_far_malloced)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 {
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
3734 Lisp_Key_Data *new_ = xnew_array (Lisp_Key_Data, size);
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 3017
diff changeset
3735 memcpy ((void *)new_, (const void *)c->keys_so_far,
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3736 c->keys_so_far_total_size * sizeof (Lisp_Key_Data));
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
3737 xfree (c->keys_so_far);
3550
be1bb4dc32b1 [xemacs-hg @ 2006-08-08 15:26:05 by james]
james
parents: 3096
diff changeset
3738 c->keys_so_far = new_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 else
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3741 XREALLOC_ARRAY (c->keys_so_far, Lisp_Key_Data, size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 c->keys_so_far_total_size = size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 c->keys_so_far_malloced = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 Lisp_Object lower;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 c->keys_count = lower_keys_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 c->modifiers_so_far = lower_modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 c->keys_count = keys_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 c->modifiers_so_far = modifiers_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 if (!firstonly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 result = nconc2 (lower, result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 else if (!NILP (lower))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 return lower;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3770 Lisp_Object firstonly, Eistring *target_buffer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 int i;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3775 Lisp_Key_Data raw[20];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 struct where_is_closure c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 c.definition = definition;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 c.shadow = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 c.firstonly = !NILP (firstonly);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 c.target_buffer = target_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 c.keys_so_far = raw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 c.keys_so_far_total_size = countof (raw);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 c.keys_so_far_malloced = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 /* Loop over each of the maps, accumulating the keys found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 For each map searched, all previous maps shadow this one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 so that bogus keys aren't listed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 for (i = 0; i < nmaps; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 Lisp_Object this_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 c.shadow_count = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 /* Reset the things set in each iteration */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 c.keys_count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 c.modifiers_so_far = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798 &c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 if (!NILP (firstonly))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 result = this_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 result = nconc2 (this_result, result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 if (NILP (firstonly))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 result = Fnreverse (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 if (c.keys_so_far_malloced)
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
3813 xfree (c.keys_so_far);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 /* Describing keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 Insert a list of all defined keys and their definitions in MAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 Optional second argument ALL says whether to include even "uninteresting"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 definitions (ie symbols with a non-nil `suppress-keymap' property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 Third argument SHADOW is a list of keymaps whose bindings shadow those
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 of map; if a binding is present in any shadowing map, it is not printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 Fourth argument PREFIX, if non-nil, should be a key sequence;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 only bindings which start with that key sequence will be printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 (map, all, shadow, prefix, mouse_only_p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 /* #### At some point, this function should be changed to accept a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 BUFFER argument. Currently, the BUFFER argument to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838 describe_map_tree is being used only internally. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 describe_map_tree (map, NILP (all), shadow, prefix,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 !NILP (mouse_only_p), Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845 /* Insert a description of the key bindings in STARTMAP,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 followed by those of all maps reachable through STARTMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 If PARTIAL is nonzero, omit certain "uninteresting" commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 (such as `undefined').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 If SHADOW is non-nil, it is a list of other maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 don't mention keys which would be shadowed by any of them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 If PREFIX is non-nil, only list bindings which start with those keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 Lisp_Object maps = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 GCPRO2 (maps, shadow);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3863 maps = Faccessible_keymaps (startmap, prefix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 for (; !NILP (maps); maps = Fcdr (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 Lisp_Object sub_shadow = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868 Lisp_Object elt = Fcar (maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 int no_prefix = (VECTORP (Fcar (elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 && XINT (Flength (Fcar (elt))) == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3872 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3873 NGCPRO3 (sub_shadow, elt, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3875 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 Lisp_Object shmap = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879 /* If the sequence by which we reach this keymap is zero-length,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3880 then the shadow maps for this keymap are just SHADOW. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 if (no_prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3883 /* If the sequence by which we reach this keymap actually has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3884 some elements, then the sequence's definition in SHADOW is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3885 what we should use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3886 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889 if (CHARP (shmap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890 shmap = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 if (!NILP (shmap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895 Lisp_Object shm = get_keymap (shmap, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896 /* If shmap is not nil and not a keymap, it completely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897 shadows this map, so don't describe this map at all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 if (!KEYMAPP (shm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3899 goto SKIP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 sub_shadow = Fcons (shm, sub_shadow);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3902 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3903
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905 /* Describe the contents of map MAP, assuming that this map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3906 itself is reached by the sequence of prefix keys KEYS (a vector).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3907 PARTIAL and SHADOW are as in `describe_map_tree'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908 Lisp_Object keysdesc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 = ((!no_prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3910 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 describe_map (Fcdr (elt), keysdesc,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913 describe_command,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 partial,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915 sub_shadow,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916 mice_only_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917 buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919 SKIP:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 describe_command (Lisp_Object definition, Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 int keymapp = !NILP (Fkeymapp (definition));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3932 GCPRO1 (definition);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 Findent_to (make_int (16), make_int (3), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 if (keymapp)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3936 buffer_insert_ascstring (XBUFFER (buffer), "<< ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 if (SYMBOLP (definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3939 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 else if (STRINGP (definition) || VECTORP (definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943 {
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3944 buffer_insert_ascstring (XBUFFER (buffer), "Kbd Macro: ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3947 else if (COMPILED_FUNCTIONP (definition))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3948 buffer_insert_ascstring (XBUFFER (buffer), "Anonymous Compiled Function");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3950 buffer_insert_ascstring (XBUFFER (buffer), "Anonymous Lambda");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 else if (KEYMAPP (definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3952 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953 Lisp_Object name = XKEYMAP (definition)->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3954 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3955 {
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3956 buffer_insert_ascstring (XBUFFER (buffer), "Prefix command ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957 if (SYMBOLP (name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958 && EQ (find_symbol_value (name), definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3959 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965 else
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3966 buffer_insert_ascstring (XBUFFER (buffer), "Prefix Command");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3967 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 else
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3969 buffer_insert_ascstring (XBUFFER (buffer), "??");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 if (keymapp)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3972 buffer_insert_ascstring (XBUFFER (buffer), " >>");
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
3973 buffer_insert_ascstring (XBUFFER (buffer), "\n");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 struct describe_map_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979 Lisp_Object *list; /* pointer to the list to update */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980 Lisp_Object partial; /* whether to ignore suppressed commands */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981 Lisp_Object shadow; /* list of maps shadowing this one */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 Lisp_Object self; /* this map */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 Lisp_Object self_root; /* this map, or some map that has this map as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 a parent. this is the base of the tree */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 int mice_only_p; /* whether we are to display only button bindings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 struct describe_map_shadow_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
3990 const Lisp_Key_Data *raw_key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 Lisp_Object self;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 struct describe_map_shadow_closure *c =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 (struct describe_map_shadow_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 if (EQ (map, c->self))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 return Qzero; /* Not shadowed; terminate search */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
4003 return !NILP (keymap_lookup_directly (map,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
4004 KEY_DATA_KEYSYM (c->raw_key),
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
4005 KEY_DATA_MODIFIERS (c->raw_key)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4012 {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
4013 Lisp_Key_Data *k = (Lisp_Key_Data *) arg;
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
4014 return keymap_lookup_directly (km, KEY_DATA_KEYSYM (k), KEY_DATA_MODIFIERS (k));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4017
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018 static void
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
4019 describe_map_mapper (const Lisp_Key_Data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 Lisp_Object binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021 void *describe_map_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 struct describe_map_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 (struct describe_map_closure *) describe_map_closure;
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
4026 Lisp_Object keysym = KEY_DATA_KEYSYM (key);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
4027 int modifiers = KEY_DATA_MODIFIERS (key);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 /* Don't mention suppressed commands. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 if (SYMBOLP (binding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031 && !NILP (closure->partial)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032 && !NILP (Fget (binding, closure->partial, Qnil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 /* If we're only supposed to display mouse bindings and this isn't one,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 then bug out. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 if (closure->mice_only_p &&
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4038 (! (
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4039 #define INCLUDE_BUTTON_ZERO
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4040 #define FROB(num) EQ (keysym, Qbutton##num) || \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4041 EQ (keysym, Qbutton##num##up) ||
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4042 #include "keymap-buttons.h"
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4043 0)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 /* If this command in this map is shadowed by some other map, ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4054 keymap_lookup_inherited_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4055 /* Cast to discard `const' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4056 (void *)key)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4057 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 /* If this key is in some map of which this map is a parent, then ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062 it (in that case, it has been shadowed).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4063 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4064 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065 Lisp_Object sh;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066 struct describe_map_shadow_closure c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067 c.raw_key = key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068 c.self = closure->self;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 sh = traverse_keymaps (closure->self_root, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 describe_map_mapper_shadow_search, &c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 if (!NILP (sh) && !ZEROP (sh))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076 /* Otherwise add it to the list to be sorted. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4078 binding),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079 *(closure->list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4082
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4084 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4085 Lisp_Object pred)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4086 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 /* obj1 and obj2 are conses of the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088 ( ( <keysym> . <modifiers> ) . <binding> )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4089 keysym and modifiers are used, binding is ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4090 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4091 int bit1, bit2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092 obj1 = XCAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4093 obj2 = XCAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4094 bit1 = XINT (XCDR (obj1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4095 bit2 = XINT (XCDR (obj2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096 if (bit1 != bit2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 return bit1 < bit2 ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4098 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 return map_keymap_sort_predicate (obj1, obj2, pred);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4100 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4102 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4103 or 2 or more symbolic keysyms that are bound to the same thing and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 have consecutive character-set-properties.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4106 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4107 elide_next_two_p (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4109 Lisp_Object s1, s2;
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
4110 extern Lisp_Object Qcharacter_of_keysym;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4112 if (NILP (XCDR (list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4113 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4115 /* next two bindings differ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116 if (!EQ (XCDR (XCAR (list)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117 XCDR (XCAR (XCDR (list)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 /* next two modifier-sets differ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 if (!EQ (XCDR (XCAR (XCAR (list))),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122 XCDR (XCAR (XCAR (XCDR (list))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 s1 = XCAR (XCAR (XCAR (list)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 s2 = XCAR (XCAR (XCAR (XCDR (list))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4128 if (SYMBOLP (s1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4129 {
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
4130 Lisp_Object code = Fget (s1, Qcharacter_of_keysym, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4131 if (CHAR_OR_CHAR_INTP (code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4133 s1 = code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4134 CHECK_CHAR_COERCE_INT (s1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136 else return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138 if (SYMBOLP (s2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139 {
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
4140 Lisp_Object code = Fget (s2, Qcharacter_of_keysym, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4141 if (CHAR_OR_CHAR_INTP (code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4142 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4143 s2 = code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4144 CHECK_CHAR_COERCE_INT (s2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4145 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4146 else return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4147 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4149 return (XCHAR (s1) == XCHAR (s2) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4150 XCHAR (s1) + 1 == XCHAR (s2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4154 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4155 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4156 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4157 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4158 struct describe_map_closure *describe_map_closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4159 (struct describe_map_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4160 describe_map_closure->self = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 map_keymap (XKEYMAP (keymap)->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 0, /* don't sort: we'll do it later */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4163 describe_map_mapper, describe_map_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4164 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4165 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4168 /* Describe the contents of map MAP, assuming that this map itself is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4169 reached by the sequence of prefix keys KEYS (a string or vector).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4170 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4172 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174 void (*elt_describer) (Lisp_Object, Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 int partial,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 Lisp_Object shadow,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 int mice_only_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178 Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181 struct describe_map_closure describe_map_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 struct buffer *buf = XBUFFER (buffer);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
4184 Ichar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186 : ((EQ (buf->ctl_arrow, Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187 || EQ (buf->ctl_arrow, Qnil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188 ? 256 : 160));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 int elided = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4190 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
4191 extern Lisp_Object Qcharacter_of_keysym;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4193 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4195 describe_map_closure.shadow = shadow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196 describe_map_closure.list = &list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197 describe_map_closure.self_root = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198 describe_map_closure.mice_only_p = mice_only_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4200 GCPRO4 (keymap, elt_prefix, shadow, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4202 traverse_keymaps (keymap, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4203 describe_map_parent_mapper, &describe_map_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4205 if (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4207 list = list_sort (list, Qnil, describe_map_sort_predicate);
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4208 buffer_insert_ascstring (buf, "\n");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4209 while (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4210 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4211 Lisp_Object elt = XCAR (XCAR (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4212 Lisp_Object keysym = XCAR (elt);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4213 int modifiers = XINT (XCDR (elt));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4215 if (!NILP (elt_prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4216 buffer_insert_lisp_string (buf, elt_prefix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4217
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4218 if (modifiers & XEMACS_MOD_META)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4219 buffer_insert_ascstring (buf, "M-");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4220 if (modifiers & XEMACS_MOD_CONTROL)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4221 buffer_insert_ascstring (buf, "C-");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4222 if (modifiers & XEMACS_MOD_SUPER)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4223 buffer_insert_ascstring (buf, "S-");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4224 if (modifiers & XEMACS_MOD_HYPER)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4225 buffer_insert_ascstring (buf, "H-");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4226 if (modifiers & XEMACS_MOD_ALT)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4227 buffer_insert_ascstring (buf, "Alt-");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4228 if (modifiers & XEMACS_MOD_SHIFT)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4229 buffer_insert_ascstring (buf, "Sh-");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4230 if (SYMBOLP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4231 {
2828
a25c824ed558 [xemacs-hg @ 2005-06-26 18:04:49 by aidan]
aidan
parents: 2720
diff changeset
4232 Lisp_Object code = Fget (keysym, Qcharacter_of_keysym, Qnil);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
4233 Ichar c = (CHAR_OR_CHAR_INTP (code)
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
4234 ? XCHAR_OR_CHAR_INT (code) : (Ichar) -1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4235 /* Calling Fsingle_key_description() would cons more */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4236 #if 0 /* This is bogus */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 if (EQ (keysym, QKlinefeed))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4238 buffer_insert_ascstring (buf, "LFD");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4239 else if (EQ (keysym, QKtab))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4240 buffer_insert_ascstring (buf, "TAB");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4241 else if (EQ (keysym, QKreturn))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4242 buffer_insert_ascstring (buf, "RET");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243 else if (EQ (keysym, QKescape))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4244 buffer_insert_ascstring (buf, "ESC");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 else if (EQ (keysym, QKdelete))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4246 buffer_insert_ascstring (buf, "DEL");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247 else if (EQ (keysym, QKspace))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4248 buffer_insert_ascstring (buf, "SPC");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 else if (EQ (keysym, QKbackspace))
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4250 buffer_insert_ascstring (buf, "BS");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 if (c >= printable_min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 buffer_insert_emacs_char (buf, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 else buffer_insert1 (buf, Fsymbol_name (keysym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 else if (CHARP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258 buffer_insert_emacs_char (buf, XCHAR (keysym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259 else
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4260 buffer_insert_ascstring (buf, "---bad keysym---");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 if (elided)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 elided = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4266 int k = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4268 while (elide_next_two_p (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4269 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4270 k++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4271 list = XCDR (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4273 if (k != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4274 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4275 if (k == 1)
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4276 buffer_insert_ascstring (buf, ", ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4277 else
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4952
diff changeset
4278 buffer_insert_ascstring (buf, " .. ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4279 elided = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 /* Print a description of the definition of this character. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 (*elt_describer) (XCDR (XCAR (list)), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286 list = XCDR (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294 syms_of_keymap (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 {
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
4296 INIT_LISP_OBJECT (keymap);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4297
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4298 DEFSYMBOL (Qminor_mode_map_alist);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4299
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4300 DEFSYMBOL (Qkeymapp);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4301
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4302 DEFSYMBOL (Qsuppress_keymap);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4303
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4304 DEFSYMBOL (Qmodeline_map);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4305 DEFSYMBOL (Qtoolbar_map);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307 DEFSUBR (Fkeymap_parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308 DEFSUBR (Fset_keymap_parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 DEFSUBR (Fkeymap_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 DEFSUBR (Fset_keymap_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 DEFSUBR (Fkeymap_prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312 DEFSUBR (Fset_keymap_prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 DEFSUBR (Fkeymap_default_binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 DEFSUBR (Fset_keymap_default_binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316 DEFSUBR (Fkeymapp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317 DEFSUBR (Fmake_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 DEFSUBR (Fmake_sparse_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 DEFSUBR (Fcopy_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 DEFSUBR (Fkeymap_fullness);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 DEFSUBR (Fmap_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 DEFSUBR (Fevent_matches_key_specifier_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324 DEFSUBR (Fdefine_key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325 DEFSUBR (Flookup_key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4326 DEFSUBR (Fkey_binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327 DEFSUBR (Fuse_global_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4328 DEFSUBR (Fuse_local_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329 DEFSUBR (Fcurrent_local_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4330 DEFSUBR (Fcurrent_global_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 DEFSUBR (Fcurrent_keymaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 DEFSUBR (Faccessible_keymaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333 DEFSUBR (Fkey_description);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4334 DEFSUBR (Fsingle_key_description);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 DEFSUBR (Fwhere_is_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336 DEFSUBR (Fdescribe_bindings_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338 DEFSUBR (Ftext_char_description);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4340 DEFSYMBOL (Qcontrol);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4341 DEFSYMBOL (Qctrl);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4342 DEFSYMBOL (Qmeta);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4343 DEFSYMBOL (Qsuper);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4344 DEFSYMBOL (Qhyper);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4345 DEFSYMBOL (Qalt);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4346 DEFSYMBOL (Qshift);
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4347 #define INCLUDE_BUTTON_ZERO
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4348 #define FROB(num) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4349 DEFSYMBOL (Qbutton##num); \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4350 DEFSYMBOL (Qbutton##num##up);
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4351 #include "keymap-buttons.h"
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4352 #define FROB(num) \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4353 DEFSYMBOL (Qmouse_##num); \
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4354 DEFSYMBOL (Qdown_mouse_##num);
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4846
diff changeset
4355 #include "keymap-buttons.h"
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4356 DEFSYMBOL (Qmenu_selection);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4357 DEFSYMBOL (QLFD);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4358 DEFSYMBOL (QTAB);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4359 DEFSYMBOL (QRET);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4360 DEFSYMBOL (QESC);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4361 DEFSYMBOL (QDEL);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4362 DEFSYMBOL (QSPC);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4363 DEFSYMBOL (QBS);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4364 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4366 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4367 vars_of_keymap (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4368 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4369 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4370 Meta-prefix character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4371 This character followed by some character `foo' turns into `Meta-foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4372 This can be any form recognized as a single key specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4373 To disable the meta-prefix-char, set it to a negative number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4374 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4375 Vmeta_prefix_char = make_char (033);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4378 A buffer which should be consulted first for all mouse activity.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4379 When a mouse-click is processed, it will first be looked up in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 local-map of this buffer, and then through the normal mechanism if there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4381 is no binding for that click. This buffer's value of `mode-motion-hook'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4382 will be consulted instead of the `mode-motion-hook' of the buffer of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 window under the mouse. You should *bind* this, not set it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385 Vmouse_grabbed_buffer = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4387 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4388 Keymap that overrides all other local keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4389 If this variable is non-nil, it is used as a keymap instead of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4390 buffer's local map, and the minor mode keymaps and extent-local keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4391 You should *bind* this, not set it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4392 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4393 Voverriding_local_map = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4395 Fset (Qminor_mode_map_alist, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4397 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4398 Keymap of key translations that can override keymaps.
2027
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4399
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4400 This keymap works like `function-key-map', but is searched before it,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4401 and applies even for keys that have ordinary bindings.
2027
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4402
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4403 The `read-key-sequence' function replaces any subsequence bound by
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4404 `key-translation-map' with its binding. More precisely, when the active
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4405 keymaps have no binding for the current key sequence but
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4406 `key-translation-map' binds a suffix of the sequence to a vector or string,
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4407 `read-key-sequence' replaces the matching suffix with its binding, and
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4408 continues with the new sequence. See `key-binding' for details.
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4409
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4410 The events that come from bindings in `key-translation-map' are not
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4411 themselves looked up in `key-translation-map'.
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4412
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4413 #### FIXME: stolen from `function-key-map'; need better example.
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4414 #### I guess you could implement a Dvorak keyboard with this?
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4415 For example, suppose `key-translation-map' binds `ESC O P' to [f1].
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4416 Typing `ESC O P' to `read-key-sequence' would return
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4417 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4418 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1]
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4419 were a prefix key, typing `ESC O P x' would return
71477bc21fe8 [xemacs-hg @ 2004-04-19 06:40:42 by stephent]
stephent
parents: 1726
diff changeset
4420 \[#<keypress-event f1> #<keypress-event x>].
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4421 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4422 Vkey_translation_map = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4423
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4424 DEFVAR_LISP ("global-tty-map", &Vglobal_tty_map /*
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4425 Global keymap that applies only to TTY's.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4426 Key bindings are looked up in this map just before looking in the global map,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4427 but only when the current console is a TTY console. See also
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4428 `global-window-system-map'.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4429 */ );
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4430 Vglobal_tty_map = Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4431
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4432 DEFVAR_LISP ("global-window-system-map", &Vglobal_window_system_map /*
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4433 Global keymap that applies only to window systems.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4434 Key bindings are looked up in this map just before looking in the global map,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4435 but only when the current console is not a TTY console. See also
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4436 `global-tty-map'.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4437 */ );
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4438 Vglobal_window_system_map = Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4439
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4440 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4441 Keymap which handles mouse clicks over vertical dividers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4442 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4443 Vvertical_divider_map = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4445 DEFVAR_INT ("keymap-tick", &keymap_tick /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4446 Incremented for each change to any keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4447 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4448 keymap_tick = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4450 staticpro (&Vcurrent_global_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4451
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
4452 Vsingle_space_string = make_string ((const Ibyte *) " ", 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4453 staticpro (&Vsingle_space_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4454 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4456 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4457 complex_vars_of_keymap (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4459 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4460 Lisp_Object ESC_prefix = intern ("ESC-prefix");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4461 Lisp_Object meta_disgustitute;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4462
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4463 Vcurrent_global_map = Fmake_keymap (Qnil);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4464 Vglobal_tty_map = Fmake_keymap (intern ("global-tty-map"));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4465 Vglobal_window_system_map =
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 722
diff changeset
4466 Fmake_keymap (intern ("global-window-system-map"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4468 meta_disgustitute = Fmake_keymap (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4469 Ffset (ESC_prefix, meta_disgustitute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4470 /* no need to protect meta_disgustitute, though */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4471 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4472 XKEYMAP (Vcurrent_global_map),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4473 meta_disgustitute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4474 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4476 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4477 }