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