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 2 - (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 :     fun lookupKC (KM(minKC, a)) (XTy.KEYCODE kc) = Array.sub(a, kc - minKC)
112 :     end
113 :    
114 :     (* the meaning of the Lock modifier key *)
115 :     datatype lock_meaning = NoLock | LockShift | LockCaps
116 :    
117 :     (* the shifting mode of a key-button state *)
118 :     datatype shift_mode = Unshifted | Shifted | CapsLocked of bool
119 :    
120 :     datatype mapping = MAP of {
121 :     lookup : XTy.keycode -> XTy.keysym list,
122 :     is_mode_switched : XTy.modkey_state -> bool,
123 :     shift_mode : XTy.modkey_state -> shift_mode
124 :     }
125 :    
126 :     (* Return the upper-case and lower-case keysyms for the given keysym *)
127 :     fun convertCase (XTy.KEYSYM sym) = let
128 :     in
129 :     case (Word.fromInt sym & 0wxFF00)
130 :     of 0w0 => ( (* Latin1 *)
131 :     if ((0x41 <= sym) andalso (sym <= 0x5A)) (* A..Z *)
132 :     then (XTy.KEYSYM(sym + (0x61-0x41)), XTy.KEYSYM sym)
133 :     else if ((0x61 <= sym) andalso (sym <= 0x7a)) (* a..z *)
134 :     then (XTy.KEYSYM sym, XTy.KEYSYM(sym - (0x61-0x41)))
135 :     else if ((0xC0 <= sym) andalso (sym <= 0xD6)) (* Agrave..Odiaeresis*)
136 :     then (XTy.KEYSYM(sym + (0xE0-0xC0)), XTy.KEYSYM sym)
137 :     else if ((0xE0 <= sym) andalso (sym <= 0xF6)) (* agrave..odiaeresis*)
138 :     then (XTy.KEYSYM sym, XTy.KEYSYM(sym - (0xE0-0xC0)))
139 :     else if ((0xD8 <= sym) andalso (sym <= 0xDE)) (* Ooblique..Thorn*)
140 :     then (XTy.KEYSYM(sym + (0xD8-0xF8)), XTy.KEYSYM sym)
141 :     else if ((0xF8 <= sym) andalso (sym <= 0xFE)) (* oslash..thorn*)
142 :     then (XTy.KEYSYM sym, XTy.KEYSYM(sym - (0xD8-0xF8)))
143 :     else (XTy.KEYSYM sym, XTy.KEYSYM sym))
144 :     | _ => (XTy.KEYSYM sym, XTy.KEYSYM sym)
145 :     end
146 :     val lowerCase = #1 o convertCase
147 :     val upperCase = #2 o convertCase
148 :    
149 :     (* Return the shift-mode defined by a list of modifiers with respect to the
150 :     * given lock meaning *)
151 :     fun shiftMode lockMeaning state = (
152 :     case (KeyBut.shiftIsSet state, KeyBut.lockIsSet state, lockMeaning)
153 :     of (false, false, _) => Unshifted
154 :     | (false, true, NoLock) => Unshifted
155 :     | (false, true, LockShift) => Shifted
156 :     | (true, true, NoLock) => Shifted
157 :     | (true, false, _) => Shifted
158 :     | (shift, _, _) => (CapsLocked shift))
159 :    
160 :     (* translate a keycode plus modifier-state to a keysym *)
161 :     fun keycodeToKeysym (MAP{lookup, is_mode_switched, shift_mode}) (kc, state) = let
162 :     (* if there are more than two keysyms for the keycode and the shift mode
163 :     * is switched, then discard the first two keysyms *)
164 :     val syms = (case (lookup kc, is_mode_switched state)
165 :     of (_::_::(r as _::_), true) => r
166 :     | (l, _) => l)
167 :     val sym = (case (syms, shift_mode state)
168 :     of ([], _) => XTy.NoSymbol
169 :     | ([ks], Unshifted) => lowerCase ks
170 :     | (ks::_, Unshifted) => ks
171 :     | ([ks], Shifted) => upperCase ks
172 :     | (_::ks::_, Shifted) => ks
173 :     | ([ks], CapsLocked _) => upperCase ks
174 :     | (lks::uks::_, CapsLocked shift) => let
175 :     val (lsym, usym) = convertCase uks
176 :     in
177 :     if (shift orelse ((uks = usym) andalso (lsym <> usym)))
178 :     then usym
179 :     else upperCase lks
180 :     end)
181 :     in
182 :     if (sym = Keysym.voidSymbol) then XTy.NoSymbol else sym
183 :     end (* keycodeToKeysym *)
184 :    
185 :     (* Get the display's modifier mapping, and analyze it to set
186 :     * the lock semantics and which modes translate into switched mode.
187 :     *)
188 :     fun createMap (dpy as XDisplay.XDPY{conn, ...}) = let
189 :     val modMap = getModifierMapping conn ()
190 :     val lookup = lookupKC (newKCMap dpy)
191 :     (* get the lock meaning, which will be LockCaps, if any lock key contains
192 :     * the CAPS_LOCK keysym (KEYSYM 0xFFE5); otherwise it will be LockShift,
193 :     * if any lock key contains the SHIFT_LOCK keysym (KEYSYM 0xFFE6); otherwise
194 :     * it will be NoLock.
195 :     *)
196 :     val lockMeaning = let
197 :     fun find ([], [], meaning) = meaning
198 :     | find (kc :: r, [], meaning) = find (r, lookup kc, meaning)
199 :     | find (kcl, (XTy.KEYSYM 0xFFE5)::_, _) = LockCaps
200 :     | find (kcl, (XTy.KEYSYM 0xFFE6)::r, _) = find(kcl, r, LockShift)
201 :     | find (kcl, _::r, meaning) = find(kcl, r, meaning)
202 :     in
203 :     find (#lock_keycodes modMap, [], NoLock)
204 :     end
205 :     (* compute a bit-vector with a 1 in bit-i if one of ModKey[i+1] keycodes
206 :     * has the Mode_switch keysym (KEYSYM 0xFF7E) in its keysym list.
207 :     *)
208 :     val switchMode = let
209 :     fun isModeSwitch [] = false
210 :     | isModeSwitch ((XTy.KEYSYM 0xFF7E) :: _) = true
211 :     | isModeSwitch (_::r) = isModeSwitch r
212 :     val chkKC = List.exists (fn kc => isModeSwitch(lookup kc))
213 :     val keys = if chkKC(#mod1_keycodes modMap)
214 :     then [XTy.Mod1Key] else []
215 :     val keys = if chkKC(#mod2_keycodes modMap)
216 :     then (XTy.Mod2Key::keys) else keys
217 :     val keys = if chkKC(#mod3_keycodes modMap)
218 :     then (XTy.Mod3Key::keys) else keys
219 :     val keys = if chkKC(#mod4_keycodes modMap)
220 :     then (XTy.Mod4Key::keys) else keys
221 :     val keys = if chkKC(#mod5_keycodes modMap)
222 :     then (XTy.Mod5Key::keys) else keys
223 :     in
224 :     KeyBut.mkModState keys
225 :     end
226 :     fun switchFn state =
227 :     not (KeyBut.emptyMod (KeyBut.intersectMod (state, switchMode)))
228 :     in
229 :     MAP{
230 :     lookup = lookup,
231 :     shift_mode = shiftMode lockMeaning,
232 :     is_mode_switched = switchFn
233 :     }
234 :     end (* createMap *)
235 :    
236 :     datatype req = Refresh | Lookup of (XTy.keycode * XTy.modkey_state)
237 :     datatype keymap = KM of {
238 :     req_ch : req CML.chan,
239 :     reply_ch : XTy.keysym CML.chan
240 :     }
241 :    
242 :     (* create the keymap server for the display connection *)
243 :     fun createKeymap (dpy as XDisplay.XDPY{conn, ...}) = let
244 :     val reqCh = CML.channel() and replyCh = CML.channel()
245 :     fun server () = let
246 :     fun loop codeToSym = loop (
247 :     case (CML.recv reqCh)
248 :     of Refresh => (keycodeToKeysym (createMap dpy))
249 :     | Lookup arg => (CML.send(replyCh, codeToSym arg); codeToSym)
250 :     )
251 :     in
252 :     loop (keycodeToKeysym (createMap dpy))
253 :     end
254 :     in
255 :     XDebug.xspawn ("KeymapServer", server);
256 :     KM {req_ch = reqCh, reply_ch = replyCh}
257 :     end (* createKeymap *)
258 :    
259 :     fun refreshKeymap (KM{req_ch, ...}) = CML.send(req_ch, Refresh)
260 :    
261 :     fun lookupKeysym (KM{req_ch, reply_ch}) ({
262 :     keycode, mod_state, ...
263 :     } : XEventTypes.key_xevtinfo) = (
264 :     CML.send(req_ch, Lookup(keycode, mod_state));
265 :     (CML.recv reply_ch, mod_state))
266 :    
267 :     end (* Keymap *)

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