Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/lib/window/keymap.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/lib/window/keymap.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 704 - (view) (download)

1 : monnier 2 (* keymap.sml
2 :     *
3 :     * COPYRIGHT (c) 1990,1991 by John H. Reppy. See COPYRIGHT file for details.
4 :     *
5 :     * Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
6 :     * and the Massachusetts Institute of Technology, Cambridge, Massachusetts.
7 :     *
8 :     * This mystery code was derived from the MIT Xlib implementation. The following
9 :     * description of the keycode to keysym translation is lifted from the X11 protocol
10 :     * definition:
11 :     *
12 :     * A KEYCODE represents a physical (or logical) key. Keycodes lie in the
13 :     * inclusive range [8,255]. A keycode value carries no intrinsic information,
14 :     * although server implementors may attempt to encode geometry information
15 :     * (for example, matrix) to be interpreted in a server-dependent fashion. The
16 :     * mapping between keys and keycodes cannot be changed using the protocol.
17 :     *
18 :     * A KEYSYM is an encoding of a symbol on the cap of a key. The set of defined
19 :     * KEYSYMs include the character sets Latin 1, Latin 2, Latin 3, Latin 4, Kana,
20 :     * Arabic, Cryllic, Greek, Tech, Special, Publish, APL, and Hebrew as well as a
21 :     * set of symbols common on keyboards (Return, Help, Tab, and so on). KEYSYMs
22 :     * with the most-significant bit (of the 29 bits) set are reserved as
23 :     * vendor-specific.
24 :     *
25 :     * A list of KEYSYMs is associated with each KEYCODE. The list is intended to
26 :     * convey the set of symbols on the corresponding key. If the list (ignoring
27 :     * trailing NoSymbol entries) is a single KEYSYM ``[K],'' then the list is
28 :     * treated as if it were the list ``[K, NoSymbol, K, NoSymbol].'' If the list
29 :     * (ignoring trailing NoSymbol entries) is a pair of KEYSYMs ``[K1, K2]'',
30 :     * then the list is treated as if it were the list ``[K1, K2, K1, K2]''. If
31 :     * the list (ignoring trailing NoSymbol entries) is a triple of KEYSYMs
32 :     * ``[K1, K2, K3]'', then the list is treated as if it were the list
33 :     * ``[K1, K2, K3, NoSymbol]''. When an explicit ``void'' element is desired
34 :     * in the list, the value VoidSymbol can be used.
35 :     *
36 :     * The first four elements of the list are split into two groups of KEYSYMs.
37 :     * Group 1 contains the first and second KEYSYMs, Group 2 contains third and
38 :     * fourth KEYSYMs. Within each group, if the second element of the group is
39 :     * NoSymbol, then the group should be treated as if the second element were the
40 :     * same as the first element, except when the first element is an alphabetic
41 :     * KEYSYM ``K'' for which both lowercase and uppercase forms are defined. In
42 :     * that case, the group should be treated as if the first element were the
43 :     * lowercase form of ``K'' and the second element were the uppercase form
44 :     * of ``K''.
45 :     *
46 :     * The standard rules for obtaining a KEYSYM from a KeyPress event make use of
47 :     * only the Group 1 and Group 2 KEYSYMs; no interpretation of other KEYSYMs in
48 :     * the list is given here. Which group to use is determined by modifier state.
49 :     * Switching between groups is controlled by the KEYSYM named MODE SWITCH, by
50 :     * attaching that KEYSYM to some KEYCODE and attaching that KEYCODE to any one
51 :     * of the modifiers Mod1 through Mod5. This modifier is called the ``group
52 :     * modifier''. For any KEYCODE, Group 1 is used when the group modifier is
53 :     * off, and Group 2 is used when the group modifier is on.
54 :     *
55 :     * Within a group, which KEYSYM to use is also determined by modifier state. The
56 :     * first KEYSYM is used when the Shift and Lock modifiers are off. The second
57 :     * KEYSYM is used when the Shift modifier is on, or when the Lock modifier is on
58 :     * and the second KEYSYM is uppercase alphabetic, or when the Lock modifier is on
59 :     * and is interpreted as ShiftLock. Otherwise, when the Lock modifier is on and
60 :     * is interpreted as CapsLock, the state of the Shift modifier is applied first
61 :     * to select a KEYSYM, but if that KEYSYM is lowercase alphabetic, then the
62 :     * corresponding uppercase KEYSYM is used instead.
63 :     *
64 :     * The KEYMASK modifier named Lock is intended to be mapped to either a CapsLock
65 :     * or a ShiftLock key, but which one is left as application-specific and/or
66 :     * user-specific. However, it is suggested that the determination be made
67 :     * according to the associated KEYSYM(s) of the corresponding KEYCODE.
68 :     *
69 :     * NOTE: XReply.decodeGetKeyboardMappingReply removes trailing NoSymbol entries.
70 :     *)
71 :    
72 :     signature KEYMAP =
73 :     sig
74 :     type keymap
75 :     val createKeymap : XDisplay.xdisplay -> keymap
76 :     val refreshKeymap : keymap -> unit
77 :     val lookupKeysym : keymap -> XEventTypes.key_xevtinfo
78 :     -> (Keysym.keysym * KeyBut.modkey_state)
79 :     end (* KEYMAP *)
80 :    
81 :     structure Keymap : KEYMAP =
82 :     struct
83 :    
84 :     structure XTy = XProtTypes
85 :    
86 :     val & = Word.andb and ++ = Word.orb
87 :     infix & ++
88 :    
89 :     fun query (encode, decode) conn = let
90 :     val requestReply = XIo.requestReply conn
91 :     in
92 :     fn req => decode (CML.sync (requestReply (encode req)))
93 :     end
94 :     val getKeyboardMapping = query
95 :     (XRequest.encodeGetKeyboardMapping, XReply.decodeGetKeyboardMappingReply)
96 :     val getModifierMapping = query
97 :     (fn () => XRequest.requestGetModifierMapping,
98 :     XReply.decodeGetModifierMappingReply)
99 :    
100 :     (* Keycode to keysym map *)
101 :     abstype keycode_map = KM of (int * XTy.keysym list array)
102 :     with
103 :     fun newKCMap (XDisplay.XDPY info) = let
104 :     val (minKeycode as (XTy.KEYCODE minKC)) = #min_keycode info
105 :     val (XTy.KEYCODE maxKC) = #max_keycode info
106 :     val kbdMap = getKeyboardMapping (#conn info)
107 :     {first=minKeycode, count=((maxKC - minKC) + 1)}
108 :     in
109 :     KM(minKC, Array.fromList kbdMap)
110 :     end
111 : jhr 704 (* NOTE: some X servers generate bogus keycodes on occasion *)
112 :     fun lookupKC (KM(minKC, a)) (XTy.KEYCODE kc) =
113 :     (Array.sub(a, kc - minKC) handle Subscript => [])
114 : monnier 2 end
115 :    
116 :     (* the meaning of the Lock modifier key *)
117 :     datatype lock_meaning = NoLock | LockShift | LockCaps
118 :    
119 :     (* the shifting mode of a key-button state *)
120 :     datatype shift_mode = Unshifted | Shifted | CapsLocked of bool
121 :    
122 :     datatype mapping = MAP of {
123 :     lookup : XTy.keycode -> XTy.keysym list,
124 :     is_mode_switched : XTy.modkey_state -> bool,
125 :     shift_mode : XTy.modkey_state -> shift_mode
126 :     }
127 :    
128 :     (* Return the upper-case and lower-case keysyms for the given keysym *)
129 :     fun convertCase (XTy.KEYSYM sym) = let
130 :     in
131 :     case (Word.fromInt sym & 0wxFF00)
132 :     of 0w0 => ( (* Latin1 *)
133 :     if ((0x41 <= sym) andalso (sym <= 0x5A)) (* A..Z *)
134 :     then (XTy.KEYSYM(sym + (0x61-0x41)), XTy.KEYSYM sym)
135 :     else if ((0x61 <= sym) andalso (sym <= 0x7a)) (* a..z *)
136 :     then (XTy.KEYSYM sym, XTy.KEYSYM(sym - (0x61-0x41)))
137 :     else if ((0xC0 <= sym) andalso (sym <= 0xD6)) (* Agrave..Odiaeresis*)
138 :     then (XTy.KEYSYM(sym + (0xE0-0xC0)), XTy.KEYSYM sym)
139 :     else if ((0xE0 <= sym) andalso (sym <= 0xF6)) (* agrave..odiaeresis*)
140 :     then (XTy.KEYSYM sym, XTy.KEYSYM(sym - (0xE0-0xC0)))
141 :     else if ((0xD8 <= sym) andalso (sym <= 0xDE)) (* Ooblique..Thorn*)
142 :     then (XTy.KEYSYM(sym + (0xD8-0xF8)), XTy.KEYSYM sym)
143 :     else if ((0xF8 <= sym) andalso (sym <= 0xFE)) (* oslash..thorn*)
144 :     then (XTy.KEYSYM sym, XTy.KEYSYM(sym - (0xD8-0xF8)))
145 :     else (XTy.KEYSYM sym, XTy.KEYSYM sym))
146 :     | _ => (XTy.KEYSYM sym, XTy.KEYSYM sym)
147 :     end
148 :     val lowerCase = #1 o convertCase
149 :     val upperCase = #2 o convertCase
150 :    
151 :     (* Return the shift-mode defined by a list of modifiers with respect to the
152 :     * given lock meaning *)
153 :     fun shiftMode lockMeaning state = (
154 :     case (KeyBut.shiftIsSet state, KeyBut.lockIsSet state, lockMeaning)
155 :     of (false, false, _) => Unshifted
156 :     | (false, true, NoLock) => Unshifted
157 :     | (false, true, LockShift) => Shifted
158 :     | (true, true, NoLock) => Shifted
159 :     | (true, false, _) => Shifted
160 :     | (shift, _, _) => (CapsLocked shift))
161 :    
162 :     (* translate a keycode plus modifier-state to a keysym *)
163 :     fun keycodeToKeysym (MAP{lookup, is_mode_switched, shift_mode}) (kc, state) = let
164 :     (* if there are more than two keysyms for the keycode and the shift mode
165 :     * is switched, then discard the first two keysyms *)
166 :     val syms = (case (lookup kc, is_mode_switched state)
167 :     of (_::_::(r as _::_), true) => r
168 :     | (l, _) => l)
169 :     val sym = (case (syms, shift_mode state)
170 :     of ([], _) => XTy.NoSymbol
171 :     | ([ks], Unshifted) => lowerCase ks
172 :     | (ks::_, Unshifted) => ks
173 :     | ([ks], Shifted) => upperCase ks
174 :     | (_::ks::_, Shifted) => ks
175 :     | ([ks], CapsLocked _) => upperCase ks
176 :     | (lks::uks::_, CapsLocked shift) => let
177 :     val (lsym, usym) = convertCase uks
178 :     in
179 :     if (shift orelse ((uks = usym) andalso (lsym <> usym)))
180 :     then usym
181 :     else upperCase lks
182 :     end)
183 :     in
184 :     if (sym = Keysym.voidSymbol) then XTy.NoSymbol else sym
185 :     end (* keycodeToKeysym *)
186 :    
187 :     (* Get the display's modifier mapping, and analyze it to set
188 :     * the lock semantics and which modes translate into switched mode.
189 :     *)
190 :     fun createMap (dpy as XDisplay.XDPY{conn, ...}) = let
191 :     val modMap = getModifierMapping conn ()
192 :     val lookup = lookupKC (newKCMap dpy)
193 :     (* get the lock meaning, which will be LockCaps, if any lock key contains
194 :     * the CAPS_LOCK keysym (KEYSYM 0xFFE5); otherwise it will be LockShift,
195 :     * if any lock key contains the SHIFT_LOCK keysym (KEYSYM 0xFFE6); otherwise
196 :     * it will be NoLock.
197 :     *)
198 :     val lockMeaning = let
199 :     fun find ([], [], meaning) = meaning
200 :     | find (kc :: r, [], meaning) = find (r, lookup kc, meaning)
201 :     | find (kcl, (XTy.KEYSYM 0xFFE5)::_, _) = LockCaps
202 :     | find (kcl, (XTy.KEYSYM 0xFFE6)::r, _) = find(kcl, r, LockShift)
203 :     | find (kcl, _::r, meaning) = find(kcl, r, meaning)
204 :     in
205 :     find (#lock_keycodes modMap, [], NoLock)
206 :     end
207 :     (* compute a bit-vector with a 1 in bit-i if one of ModKey[i+1] keycodes
208 :     * has the Mode_switch keysym (KEYSYM 0xFF7E) in its keysym list.
209 :     *)
210 :     val switchMode = let
211 :     fun isModeSwitch [] = false
212 :     | isModeSwitch ((XTy.KEYSYM 0xFF7E) :: _) = true
213 :     | isModeSwitch (_::r) = isModeSwitch r
214 :     val chkKC = List.exists (fn kc => isModeSwitch(lookup kc))
215 :     val keys = if chkKC(#mod1_keycodes modMap)
216 :     then [XTy.Mod1Key] else []
217 :     val keys = if chkKC(#mod2_keycodes modMap)
218 :     then (XTy.Mod2Key::keys) else keys
219 :     val keys = if chkKC(#mod3_keycodes modMap)
220 :     then (XTy.Mod3Key::keys) else keys
221 :     val keys = if chkKC(#mod4_keycodes modMap)
222 :     then (XTy.Mod4Key::keys) else keys
223 :     val keys = if chkKC(#mod5_keycodes modMap)
224 :     then (XTy.Mod5Key::keys) else keys
225 :     in
226 :     KeyBut.mkModState keys
227 :     end
228 :     fun switchFn state =
229 :     not (KeyBut.emptyMod (KeyBut.intersectMod (state, switchMode)))
230 :     in
231 :     MAP{
232 :     lookup = lookup,
233 :     shift_mode = shiftMode lockMeaning,
234 :     is_mode_switched = switchFn
235 :     }
236 :     end (* createMap *)
237 :    
238 :     datatype req = Refresh | Lookup of (XTy.keycode * XTy.modkey_state)
239 :     datatype keymap = KM of {
240 :     req_ch : req CML.chan,
241 :     reply_ch : XTy.keysym CML.chan
242 :     }
243 :    
244 :     (* create the keymap server for the display connection *)
245 :     fun createKeymap (dpy as XDisplay.XDPY{conn, ...}) = let
246 :     val reqCh = CML.channel() and replyCh = CML.channel()
247 :     fun server () = let
248 :     fun loop codeToSym = loop (
249 :     case (CML.recv reqCh)
250 :     of Refresh => (keycodeToKeysym (createMap dpy))
251 :     | Lookup arg => (CML.send(replyCh, codeToSym arg); codeToSym)
252 :     )
253 :     in
254 :     loop (keycodeToKeysym (createMap dpy))
255 :     end
256 :     in
257 :     XDebug.xspawn ("KeymapServer", server);
258 :     KM {req_ch = reqCh, reply_ch = replyCh}
259 :     end (* createKeymap *)
260 :    
261 :     fun refreshKeymap (KM{req_ch, ...}) = CML.send(req_ch, Refresh)
262 :    
263 :     fun lookupKeysym (KM{req_ch, reply_ch}) ({
264 :     keycode, mod_state, ...
265 :     } : XEventTypes.key_xevtinfo) = (
266 :     CML.send(req_ch, Lookup(keycode, mod_state));
267 :     (CML.recv reply_ch, mod_state))
268 :    
269 :     end (* Keymap *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0