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