9 let tempfailureretry f a
=
11 try f a
with Unix.Unix_error
(Unix.EINTR
, _
, _
) -> g ()
15 external cloexec
: Unix.file_descr
-> unit = "ml_cloexec";;
16 external glx
: int -> unit = "ml_glx";;
17 external glxsync
: unit -> unit = "ml_glxsync";;
18 external swapb
: unit -> unit = "ml_swapb";;
19 external hasdata
: Unix.file_descr
-> bool = "ml_hasdata";;
20 external toutf8
: int -> string = "ml_keysymtoutf8";;
22 let dolog fmt
= Format.kprintf prerr_endline fmt
;;
23 let vlog fmt
= Format.kprintf ignore fmt
;;
28 method reshape _ _
= ()
29 method mouse _ _ _ _ _
= ()
30 method motion _ _
= ()
31 method pmotion _ _
= ()
41 method reshape
: int -> int -> unit
42 method mouse
: int -> bool -> int -> int -> int -> unit
43 method motion
: int -> int -> unit
44 method pmotion
: int -> int -> unit
45 method key
: int -> int -> unit
46 method enter
: int -> int -> unit
54 ; mutable keymap
: int array array
55 ; fifo
: (string -> unit) Queue.t
57 ; mutable protoatom
: int
58 ; mutable deleatom
: int
59 ; mutable idbase
: int
60 ; mutable fullscreen
: (int -> unit)
61 ; mutable setwmname
: (string -> unit)
62 ; mutable actwin
: (unit -> unit)
63 ; mutable stringatom
: int
65 ; mutable sock
: Unix.file_descr
71 ; mutable curcurs
: cursor
72 ; mutable capslmask
: int
73 ; mutable numlmask
: int
74 ; mutable levl3mask
: int
75 ; mutable levl5mask
: int
79 | Fs
of (int * int * int * int)
86 ; fifo
= Queue.create
()
91 ; fullscreen
= (fun _
-> ())
92 ; setwmname
= (fun _
-> ())
93 ; actwin
= (fun _
-> ())
102 ; curcurs
= CURSOR_INHERIT
110 let w8 s pos i
= String.set s pos
(Char.chr
(i
land 0xff));;
114 w8 s
(pos
+1) (i
lsr 8);
119 w16 s
(pos
+2) (i
lsr 16);
123 let rb pos1
= Char.code
(String.get s
(pos
+ pos1
)) in
124 (rb 0) lor ((rb 1) lsl 8)
129 i - ((i land 0x8000) lsl 1);
132 let r8 s pos
= Char.code
(String.get s pos
);;
135 let rb pos1
= Char.code
(String.get s
(pos
+ pos1
)) in
136 let l = (rb 0) lor ((rb 1) lsl 8)
137 and u
= (rb 2) lor ((rb 3) lsl 8) in
141 let exntos = function
142 | Unix.Unix_error
(e
, s
, a
) -> Printf.sprintf
"%s(%s):%s(%d)"
143 s a
(Unix.error_message e
) (Obj.magic e
)
144 | exn
-> Printexc.to_string exn
;
147 let error fmt
= Printf.kprintf failwith fmt
;;
150 let s = String.create n
in
152 let m = tempfailureretry (Unix.read sock
s pos
) n
in
157 ignore
(tempfailureretry (Unix.select
[sock
] [] []) 0.01);
158 loop (pos
+ m) (n
- m)
165 let sendstr1 s pos len sock
=
166 vlog "%d => %S" state.seq
s;
167 state.seq
<- state.seq
+ 1;
168 let n = tempfailureretry (Unix.send sock
s pos len
) [] in
170 then error "send %d returned %d" len
n;
173 let updkmap sock resp
=
174 let syms = r8 resp
1 in
175 let len = r32 resp
4 in
178 then readstr sock
(4*len)
181 let m = len / syms in
182 state.keymap
<- Array.make_matrix
183 (state.maxk
- state.mink
) syms 0xffffff;
184 let rec loop i = if i = m then () else
186 let rec loop2 k l = if l = syms then () else
187 let v = r32 data k in
188 state.keymap
.(i).(l) <- v;
197 let updmodmap sock resp
=
199 let len = r16 resp
4 in
202 then readstr sock
(len*4)
205 let modmap = Array.make_matrix
8 n 0xffffff in
206 let rec loop l = if l = 8 then () else
208 let rec loop1 m = if m = n then () else
210 let code = r8 data p in
211 modmap.(l).(m) <- code;
214 let ki = code - state.mink
in
217 let a = state.keymap
.(ki) in
218 let rec capsloop i = if i = Array.length
a || i > 3 then () else
221 then state.capslmask
<- 2
229 let ki = code - state.mink
in
232 let a = state.keymap
.(ki) in
233 let rec lloop i = if i = Array.length
a || i > 3 then () else
236 | 0xfe03 -> state.levl3mask
<- 1 lsl l
237 | 0xfe11 -> state.levl5mask
<- 1 lsl l
238 | 0xff7f -> state.numlmask
<- 1 lsl l
252 let sendwithrep sock
s f
=
253 Queue.push f
state.fifo
;
254 sendstr1 s 0 (String.length
s) sock
;
258 let b = Buffer.create
16 in
259 List.iter
(Buffer.add_string
b) ss
;
260 let bl = Buffer.length
b in
261 let pl = bl land 3 in
265 Buffer.add_substring
b pad 0 (4 - pl);
270 let padcat s1 s2
= padcatl [s1
; s2
];;
272 let internreq name onlyifexists
=
273 let s = "\016\000\000\000\000\000\000\000" in
274 let s = padcat s name
in
275 if onlyifexists
then w8 s 1 1;
276 w16 s 2 (String.length
s / 4);
277 w16 s 4 (String.length name
);
281 let sendintern sock
s onlyifexists f
=
282 let s = internreq s onlyifexists
in
283 sendwithrep sock
s f
;
286 let createwindowreq wid parent x y w h bw mask
=
287 let s = "\001\000\009\000wwwwppppxxyywwhhbwccvvvvmmmmeeee" in
297 w32 s 28 0x800; (* eventmask *)
302 let getgeometryreq wid
=
303 let s = "\014u\002\000dddd" in
309 let s = "\008u\002\000wwww" in
314 let getkeymapreq first count
=
315 let s = "\101u\002\000fcuu" in
321 let changepropreq wid prop typ format props
=
322 let s = "\018\000llwwwwppppttttfuuuLLLL" in
323 let s = padcat s props
in
324 w16 s 2 (String.length
s / 4);
329 let ful = String.length props
/ (match format
with
333 | n -> error "no idea what %d means" n)
339 let openfontreq fid name
=
340 let s = "\045ullffffnnuu" in
341 let s = padcat s name
in
342 w16 s 2 (String.length
s / 4);
344 w16 s 8 (String.length name
);
348 let createglyphcursorreq fid cid cindex
=
349 let s = "\094u\008\000ccccffffffffssmmrrggbbRRGGBB" in
364 let changewindowattributesreq wid mask attrs
=
365 let s = "\002ullwwwwmmmm" in
366 let s = padcat s attrs
in
367 w16 s 2 (String.length
s / 4);
373 let configurewindowreq wid mask values
=
374 let s = "\012ullwwwwmmuu" in
375 let s = padcat s values
in
376 w16 s 2 (String.length
s / 4);
388 let clientmessage format seq wid typ
data =
389 let s = "\033fsswwwwtttt" in
390 let s = padcat s data in
398 let sendeventreq propagate destwid mask
data =
399 let s = "\025p\011\000wwwwmmmm" in
400 let s = padcat s data in
407 let getmodifiermappingreq () =
408 let s = "\119u\001\000" in
412 let getkeysym code mask
=
413 let pkpk = state.keymap
.(code-state.mink
).(0) in
414 if (pkpk >= 0xff80 && pkpk <= 0xffbd)
415 || (pkpk >= 0x11000000 && pkpk <= 0x1100ffff)
417 if mask
land state.numlmask
!= 0
419 let keysym = state.keymap
.(code-state.mink
).(1) in
420 if keysym = 0 then pkpk else keysym
424 let shift = (mask
land 1) lxor ((mask
land state.capslmask
) lsr 1) in
426 let l3 = (mask
land state.levl3mask
) != 0 in
427 let l4 = (mask
land state.levl5mask
) != 0 in
429 if l3 then (if l4 then 8 else 4) else (if l4 then 6 else 0)
431 let keysym = state.keymap
.(code-state.mink
).(index) in
432 if index land 1 = 1 && keysym = 0
433 then state.keymap
.(code-state.mink
).(index - 1)
439 let resp = readstr sock
32 in
440 let opcode = r8 resp 0 in
441 match opcode land lnot
0x80 with
446 and resid
= r32 resp 4
449 error "code=%d serial=%d resid=%#x min=%d maj=%d\n%S"
450 code serial resid min maj
resp;
452 | 1 -> (* response *)
453 let rep = Queue.pop
state.fifo
in
456 | 2 -> (* key press *)
457 if Array.length
state.keymap
> 0
459 let code = r8 resp 1 in
460 let mask = r16 resp 28 in
461 let keysym = getkeysym code mask in
462 vlog "keysym = %x %c mask %#x code %d"
463 keysym (Char.unsafe_chr
keysym) mask code;
464 state.t#key
keysym mask;
466 | 3 -> (* key release *)
467 if Array.length
state.keymap
> 0
469 let code = r8 resp 1 in
470 let mask = r16 resp 28 in
471 let keysym = getkeysym code mask in
472 vlog "release keysym = %x %c mask %#x code %#d"
473 keysym (Char.unsafe_chr
keysym) mask code
475 | 4 -> (* buttonpress *)
479 and m = r16 resp 28 in
480 state.t#mouse
n true x y
m;
483 | 5 -> (* buttonrelease *)
487 and m = r16 resp 28 in
488 state.t#mouse
n false x y
m;
489 vlog "release %d %d %d" n x y
492 let x = r16s resp 24 in
493 let y = r16s resp 26 in
494 let m = r16 resp 28 in
496 then state.t#pmotion
x y
497 else state.t#motion
x y;
498 vlog "move %dx%d => %d" x y m
502 and y = r16s resp 26 in
504 vlog "enter %d %d" x y
509 | 18 -> vlog "unmap";
514 | 12 -> (* exposure *)
518 | 15 -> (* visibility *)
519 let vis = r8 resp 8 in
520 if vis != 2 then state.t#expose
;
521 vlog "visibility %d" vis;
523 | 34 -> (* mapping *)
524 state.keymap
<- [||];
525 let s = getkeymapreq state.mink
(state.maxk
-state.mink
-1) in
526 sendwithrep sock
s (updkmap sock
);
527 state.capslmask
<- 0;
528 state.levl3mask
<- 0;
529 state.levl5mask
<- 0;
531 let s = getmodifiermappingreq () in
532 sendwithrep sock
s (updmodmap sock
);
535 | 33 -> (* clientmessage *)
536 let atom = r32 resp 8 in
537 if atom = state.protoatom
539 let atom = r32 resp 12 in
540 if atom = state.deleatom
545 | 21 -> (* reparent *)
548 | 22 -> (* configure *)
552 and h
= r16 resp 22 in
553 vlog "configure cur [%d %d %d %d] conf [%d %d %d %d]"
554 state.x state.y state.w
state.h
558 if w
!= state.w
|| h
!= state.h
569 dolog "event %d %S" n resp
575 if hasdata sock
then loop ();
580 let sendstr s ?
(pos
=0) ?
(len=String.length
s) sock
=
581 sendstr1 s pos
len sock
;
582 if hasdata sock
then readresp sock
;
588 let s = "wwuuhhuu" in
591 let s = configurewindowreq state.idbase
0x000c s in
592 sendstr s state.sock
;
593 else state.fullscreen
state.idbase
600 let syncsendwithrep sock secstowait
s f
=
601 let completed = ref false in
602 sendwithrep sock
s (fun resp -> f
resp; completed := true);
603 let now = Unix.gettimeofday
in
604 let deadline = now () +. secstowait
in
605 let rec readtillcompletion () =
607 let timeout = deadline -. now () in
610 else Unix.select
[sock
] [] [] timeout
612 let r, _
, _
= tempfailureretry sf deadline in
614 | [] -> error "didn't get X response in %f seconds, aborting" secstowait
618 then readtillcompletion ()
620 readtillcompletion ();
623 let syncsendintern sock secstowait
s onlyifexists f
=
624 let s = internreq s onlyifexists
in
625 syncsendwithrep sock secstowait
s f
;
628 let setup sock screennum w h
=
629 let s = readstr sock
2 in
630 let n = String.length
s in
632 then error "failed to read X connection setup response n=%d" n;
635 let reasonlen = r8 s 1 in
636 let s = readstr sock
6 in
641 let data = readstr sock
len in
642 let reason = String.sub
data 0 reasonlen in
643 error "X connection failed maj=%d min=%d reason=%S"
646 | '
\002'
-> failwith
"X connection setup failed: authentication required";
649 let s = readstr sock
38 in
653 and idbase
= r32 s 10
654 and idmask
= r32 s 14
656 and screens
= r8 s 26
657 and formats
= r8 s 27
659 and maxkk
= r8 s 33 in
660 let data = readstr sock
(4*add
-32) in
661 let vendor = String.sub
data 0 vlen
in
662 let pos = ((vlen
+3) land lnot
3) + formats
*8 in
664 if screennum
>= screens
665 then error "invalid screen %d, max %d" screennum
(screens
-1);
669 let rec findscreen n pos = if n = screennum
then pos else
671 let ndepths = r8 s (pos+39) in
672 let rec skipdepths n pos = if n = ndepths then pos else
674 let nvisiuals = r16 s (pos+2) in
675 pos + nvisiuals*24 + 8
679 skipdepths n (pos+40)
685 let root = r32 data pos in
686 let rootw = r16 data (pos+20)
687 and rooth
= r16 data (pos+22) in
690 state.idbase
<- idbase
;
691 vlog "vendor = %S, maj=%d min=%d" vendor maj min
;
692 vlog "screens = %d formats = %d" screens formats
;
693 vlog "minkk = %d maxkk = %d" minkk maxkk
;
694 vlog "idbase = %#x idmask = %#x" idbase idmask
;
695 vlog "root=%#x %dx%d" root rootw rooth
;
698 + 0x00000001 (* KeyPress *)
699 (* + 0x00000002 *) (* KeyRelease *)
700 + 0x00000004 (* ButtonPress *)
701 + 0x00000008 (* ButtonRelease *)
702 + 0x00000010 (* EnterWindow *)
703 + 0x00000020 (* LeaveWindow *)
704 + 0x00000040 (* PointerMotion *)
705 (* + 0x00000080 *) (* PointerMotionHint *)
706 (* + 0x00000100 *) (* Button1Motion *)
707 (* + 0x00000200 *) (* Button2Motion *)
708 (* + 0x00000400 *) (* Button3Motion *)
709 (* + 0x00000800 *) (* Button4Motion *)
710 (* + 0x00001000 *) (* Button5Motion *)
711 + 0x00002000 (* ButtonMotion *)
712 (* + 0x00004000 *) (* KeymapState *)
713 + 0x00008000 (* Exposure *)
714 + 0x00010000 (* VisibilityChange *)
715 + 0x00020000 (* StructureNotify *)
716 (* + 0x00040000 *) (* ResizeRedirect *)
717 (* + 0x00080000 *) (* SubstructureNotify *)
718 (* + 0x00100000 *) (* SubstructureRedirect *)
719 (* + 0x00200000 *) (* FocusChange *)
720 (* + 0x00400000 *) (* PropertyChange *)
721 (* + 0x00800000 *) (* ColormapChange *)
722 (* + 0x01000000 *) (* OwnerGrabButton *)
724 let wid = state.idbase
in
725 let s = createwindowreq wid root 0 0 w h
0 mask in
728 sendintern sock
"WM_PROTOCOLS" false (fun resp ->
729 state.protoatom
<- r32 resp 8;
730 sendintern sock
"WM_DELETE_WINDOW" false (fun resp ->
731 state.deleatom
<- r32 resp 8;
732 let s = s32 state.deleatom
in
733 let s = changepropreq wid state.protoatom
4 32 s in
738 sendintern sock
"WM_CLIENT_MACHINE" false (fun resp ->
739 let atom = r32 resp 8 in
742 try Unix.gethostname
()
744 dolog "error getting host name: %s" (exntos exn
);
749 let s = changepropreq wid atom state.stringatom
8 hostname in
751 sendintern sock
"_NET_WM_PID" false (fun resp ->
752 let atom = r32 resp 8 in
753 let pid = Unix.getpid
() in
755 let s = changepropreq wid atom (* cardinal *)6 32 s in
760 state.actwin
<- (fun () ->
762 let s = configurewindowreq state.idbase
0x40 s in
763 sendstr s state.sock
;
764 let s = mapreq state.idbase
in
765 sendstr s state.sock
;
768 sendintern sock
"_NET_ACTIVE_WINDOW" true (fun resp ->
769 let atom = r32 resp 8 in
770 state.actwin
<- (fun () ->
771 let data = String.make
20 '
\000'
in
772 let cm = clientmessage 32 0 wid atom data in
773 let s = sendeventreq 0 root 0x180000 cm in
774 sendstr s state.sock
;
778 syncsendintern sock
2.0 "WM_CLASS" false (fun resp ->
779 let atom = r32 resp 8 in
780 let llpp = "llpp\000llpp\000" in
781 let s = changepropreq wid atom 31 8 llpp in
785 let s = mapreq wid in
788 let s = getkeymapreq state.mink
(state.maxk
-state.mink
) in
789 sendwithrep sock
s (updkmap sock
);
791 let s = getmodifiermappingreq () in
792 sendwithrep sock
s (updmodmap sock
);
794 let s = openfontreq (wid+1) "cursor" in
797 Array.iteri
(fun i glyphindex
->
798 let s = createglyphcursorreq (wid+1) (wid+2+i) glyphindex
in
800 ) [|34;48;50;58;128;152|];
802 sendintern sock
"UTF8_STRING" true (fun resp ->
803 let atom = r32 resp 8 in
805 then state.stringatom
<- atom;
809 let s = changepropreq state.idbase
39 state.stringatom
8 s in
810 sendstr s state.sock
;
812 state.setwmname <- setwmname;
813 sendintern sock
"_NET_WM_NAME" true (fun resp ->
814 let atom = r32 resp 8 in
816 then state.setwmname <- (fun s ->
818 let s = changepropreq state.idbase
atom state.stringatom
8 s in
819 sendstr s state.sock
;
823 state.fullscreen
<- (fun wid ->
824 let s = "xxuuyyuuwwuuhhuu" in
831 let s = configurewindowreq wid 0x000f s in
832 sendstr s state.sock
;
833 state.fs
<- Fs
(state.x, state.y, state.w
, state.h
);
840 let s = configurewindowreq wid 0x000f s in
841 sendstr s state.sock
;
845 sendintern sock
"_NET_WM_STATE" true (fun resp ->
846 let nwmsatom = r32 resp 8 in
849 sendintern sock
"_NET_WM_STATE_FULLSCREEN" true (fun resp ->
850 let fsatom = r32 resp 8 in
855 let data = String.make
20 '
\000'
in
858 | NoFs
-> Fs
(-1, -1, -1, -1), 1
864 let cm = clientmessage 32 0 wid nwmsatom data in
865 let s = sendeventreq 0 root 0x180000 cm in
871 let s = getgeometryreq wid in
872 syncsendwithrep sock
2.0 s (fun resp ->
875 and h
= r16 resp 18 in
881 error "unknown conection setup response %d" (Char.code c
)
884 let getauth haddr dnum
=
886 if haddr = "localhost" || String.length
haddr = 0
888 try Unix.gethostname
()
890 dolog "failed to resolve `%S': %s" haddr (exntos exn
);
895 try Sys.getenv
"XAUTHORITY"
897 try Filename.concat
(Sys.getenv
"HOME") ".Xauthority"
901 let input_string ic
len =
902 let s = String.create
len in
903 really_input ic
s 0 len;
907 let rb pos = Char.code (String.get
s pos) in
908 (rb 1) lor ((rb 0) lsl 8)
912 let s = input_string ic
2 in
916 let family = input_string ic
2 in
920 try Some
(int_of_string
nums)
923 "display number(%S) is not an integer (corrupt %S?): %s"
924 nums path (exntos exn
);
930 vlog "family %S addr %S(%S) num %S(%d) name %S data %S"
931 family addr haddr nums dnum
name data;
933 | Some num
when addr = haddr && num
= dnum
->
940 | End_of_file
-> "", ""
942 dolog "exception while reading X authority data (%S): %s"
951 if String.length
path = 0
953 else Some
(open_in_bin
path)
955 if Sys.file_exists
path
957 dolog "failed to open X authority file `%S' : %s"
963 | Some ic
-> readauth ic
968 try Sys.getenv
"DISPLAY"
970 error "could not get DISPLAY evironment variable: %s"
975 then error "invalid DISPLAY(%s) %S" w d
977 let s = String.sub
d b (e
- b) in
980 error "invalid DISPLAY %S can not parse %s(%S): %s"
984 if pos = String.length
d
985 then error "invalid DISPLAY %S no display number specified" d
989 let rec pdispnum pos1
=
990 if pos1
= String.length
d
991 then getnum "display number" (pos+1) pos1
, 0
995 let dispnum = getnum "display number" (pos+1) pos1
in
996 let rec pscreennum pos2
=
997 if pos2
= String.length
d
998 then getnum "screen number" (pos1
+1) pos2
1001 | '
0'
.. '
9'
-> pscreennum (pos2
+1)
1003 error "invalid DISPLAY %S, cannot parse screen number" d
1005 dispnum, pscreennum (pos1
+1)
1006 | '
0'
.. '
9'
-> pdispnum (pos1
+1)
1008 error "invalid DISPLAY %S, cannot parse display number" d
1010 String.sub
d 0 pos, pdispnum (pos+1)
1014 let host, (dispnum, screennum
) = phost 0 in
1015 let aname, adata
= getauth host dispnum in
1018 if osx
|| String.length
host = 0 || host = "unix"
1022 then Unix.ADDR_UNIX
d
1023 else Unix.ADDR_UNIX
("/tmp/.X11-unix/X" ^ string_of_int
dispnum)
1025 let fd = Unix.socket
Unix.PF_UNIX
Unix.SOCK_STREAM
0 in
1029 try Unix.gethostbyname
host
1031 error "cannot resolve %S: %s" host (exntos exn
)
1033 let addr = h.Unix.h_addr_list
.(0) in
1034 let port = 6000 + dispnum in
1035 let fd = Unix.socket
Unix.PF_INET
Unix.SOCK_STREAM
0 in
1036 fd, (Unix.ADDR_INET
(addr, port))
1038 try Unix.connect
fd addr; fd
1040 error "failed to connect to X: %s" (exntos exn
)
1043 let s = "luMMmmnndduu" in
1044 let s = padcat s aname in
1045 let s = padcat s adata
in
1048 w16 s 6 (String.length
aname);
1049 w16 s 8 (String.length adata
);
1050 sendstr1 s 0 (String.length
s) fd;
1052 setup fd screennum
w h;
1054 fd, state.w, state.h;
1061 let setcursor cursor
=
1062 if cursor
!= state.curcurs
1066 | CURSOR_INHERIT
-> -1
1069 | CURSOR_CROSSHAIR
-> 0
1072 let s = s32 (if n = -1 then 0 else state.idbase
+2+n) in
1073 let s = changewindowattributesreq state.idbase
(*cursor*)0x4000 s in
1074 sendstr s state.sock
;
1075 state.curcurs
<- cursor
;
1079 state.fullscreen state.idbase
;
1082 let metamask = 0x40;;
1087 let withalt mask = mask land altmask != 0;;
1088 let withctrl mask = mask land ctrlmask != 0;;
1089 let withshift mask = mask land shiftmask != 0;;
1090 let withmeta mask = mask land metamask != 0;;
1091 let withnone mask = mask land (altmask + ctrlmask + shiftmask + metamask) = 0;;
1094 let t = Hashtbl.create
20
1095 and f
= Hashtbl.create
20 in
1097 List.iter
(fun s -> Hashtbl.add t s k) (n::nl
);
1101 let s = String.create
1 in
1103 add s [] (Char.code c
)
1106 let an = Char.code a and bn
= Char.code b in
1107 for i = an to bn
do addc (Char.chr
i) done;
1112 String.iter
addc "`~!@#$%^&*()-_=+\\|[{]};:,./<>?";
1113 for i = 0 to 29 do add ("f" ^ string_of_int
(i+1)) [] (0xffbe + i) done;
1114 add "space" [] 0x20;
1115 add "ret" ["return"; "enter"] 0xff0d;
1116 add "tab" [] 0xff09;
1117 add "left" [] 0xff51;
1118 add "right" [] 0xff53;
1119 add "home" [] 0xff50;
1120 add "end" [] 0xff57;
1121 add "ins" ["insert"] 0xff63;
1122 add "del" ["delete"] 0xffff;
1123 add "esc" ["escape"] 0xff1b;
1124 add "pgup" ["pageup"] 0xff55;
1125 add "pgdown" ["pagedown"] 0xff56;
1126 add "backspace" [] 0xff08;
1128 add "down" [] 0xff54;
1133 try Hashtbl.find xlatf
k
1134 with Not_found
-> Printf.sprintf
"%#x" k;
1138 try Hashtbl.find xlatt name
1140 if String.length
name = 1
1141 then Char.code name.[0]
1142 else int_of_string
name;