wsi.ml

   1 type cursor =
   2     | CURSOR_INHERIT
   3     | CURSOR_INFO
   4     | CURSOR_CYCLE
   5     | CURSOR_CROSSHAIR
   6     | CURSOR_TEXT
   7 ;;
   8
   9 external cloexec : Unix.file_descr -> unit = "ml_cloexec";;
  10 external glx : int -> unit = "ml_glx";;
  11 external swapb : unit -> unit = "ml_swapb";;
  12 external hasdata : Unix.file_descr -> bool = "ml_hasdata";;
  13 external toutf8 : int -> string = "ml_keysymtoutf8";;
  14
  15 let dolog fmt = Format.kprintf prerr_endline fmt;;
  16 let vlog fmt = Format.kprintf ignore fmt;;
  17
  18 exception Quit;;
  19
  20 let onot = object
  21     method display = ()
  22     method reshape _ _ = ()
  23     method mouse _ _ _ _ _ = ()
  24     method motion _ _ = ()
  25     method pmotion _ _ = ()
  26     method key _ _ = ()
  27 end;;
  28
  29 class type t = object
  30   method display : unit
  31   method reshape : int -> int -> unit
  32   method mouse : int -> bool -> int -> int -> int -> unit
  33   method motion : int -> int -> unit
  34   method pmotion : int -> int -> unit
  35   method key : int -> int -> unit
  36 end;;
  37
  38 type state =
  39     { mutable mink : int
  40     ; mutable maxk : int
  41     ; mutable keymap : int array array
  42     ; fifo : (string -> unit) Queue.t
  43     ; mutable seq : int
  44     ; mutable protoatom : int
  45     ; mutable deleatom : int
  46     ; mutable idbase : int
  47     ; mutable fullscreen : (int -> unit)
  48     ; mutable stringatom : int
  49     ; mutable t : t
  50     ; mutable sock : Unix.file_descr
  51     ; mutable w : int
  52     ; mutable h : int
  53     ; mutable fs : bool
  54     }
  55 ;;
  56
  57 let state =
  58   { mink = max_int
  59   ; maxk = min_int
  60   ; keymap = [||]
  61   ; fifo = Queue.create ()
  62   ; seq = 0
  63   ; protoatom = -1
  64   ; deleatom = -1
  65   ; idbase = -1
  66   ; fullscreen = (fun _ -> ())
  67   ; sock = Unix.stdin
  68   ; t = onot
  69   ; w = 900
  70   ; h = 900
  71   ; fs = false
  72   ; stringatom = 31
  73   }
  74 ;;
  75
  76 let w8 s pos i = String.set s pos (Char.chr (i land 0xff));;
  77
  78 let w16 s pos i =
  79   w8 s pos i;
  80   w8 s (pos+1) (i lsr 8);
  81 ;;
  82
  83 let w32 s pos i =
  84   w16 s pos i;
  85   w16 s (pos+2) (i lsr 16);
  86 ;;
  87
  88 let r16 s pos =
  89   let rb pos1 = Char.code (String.get s (pos + pos1)) in
  90   (rb 0) lor ((rb 1) lsl 8)
  91 ;;
  92
  93 let r16s s pos =
  94   let i = r16 s pos in
  95   i - ((i land 0x8000) lsl 1);
  96 ;;
  97
  98 let r8 s pos = Char.code (String.get s pos);;
  99
 100 let r32 s pos =
 101   let rb pos1 = Char.code (String.get s (pos + pos1)) in
 102   let l = (rb 0) lor ((rb 1) lsl 8)
 103   and u = (rb 2) lor ((rb 3) lsl 8) in
 104   (u lsl 16) lor l
 105 ;;
 106
 107 let error fmt = Printf.kprintf failwith fmt;;
 108
 109 let readstr sock n =
 110   let s = String.create n in
 111   let rec loop pos n =
 112     let m = Unix.read sock s pos n in
 113     if n != m
 114     then (
 115       ignore (Unix.select [sock] [] [] 0.01);
 116       loop (pos + m) (n - m)
 117     )
 118       (* error "read %d returned %d" n m; *)
 119   in
 120   loop 0 n;
 121   s;
 122 ;;
 123
 124 let sendstr s ?(pos=0) ?(len=String.length s) sock =
 125   vlog "%d => %S" state.seq s;
 126   state.seq <- state.seq + 1;
 127   let n = Unix.send sock s pos len [] in
 128   if n != len
 129   then error "send %d returned %d" len n;
 130 ;;
 131
 132 let updkmap sock resp =
 133   let syms = r8 resp 1 in
 134   let len = r32 resp 4 in
 135   let data =
 136     if len > 0
 137     then readstr sock (4*len)
 138     else ""
 139   in
 140   let m = len / syms in
 141   state.keymap <- Array.make_matrix
 142     (state.maxk - state.mink) syms 0xffffff;
 143   let rec loop i = if i = m then () else
 144       let k = i*4*syms in
 145       let rec loop2 k l = if l = syms then () else
 146           let v = r32 data k in
 147           state.keymap.(i).(l) <- v;
 148           loop2 (k+4) (l+1)
 149       in
 150       loop2 k 0;
 151       loop (i+1);
 152   in
 153   loop 0;
 154 ;;
 155
 156 let sendwithrep sock s f =
 157   Queue.push f state.fifo;
 158   sendstr s sock;
 159 ;;
 160
 161 let padcatl ss =
 162   let b = Buffer.create 16 in
 163   List.iter (Buffer.add_string b) ss;
 164   let bl = Buffer.length b in
 165   let pl = bl land 3 in
 166   if pl != 0
 167   then (
 168     let pad = "123" in
 169     Buffer.add_substring b pad 0 (4 - pl);
 170   );
 171   Buffer.contents b;
 172 ;;
 173
 174 let padcat s1 s2 = padcatl [s1; s2];;
 175
 176 let internreq name onlyifexists =
 177   let s = "\016\000\000\000\000\000\000\000" in
 178   let s = padcat s name in
 179   w8 s 1 (if onlyifexists then 1 else 0);
 180   w16 s 2 (String.length s / 4);
 181   w16 s 4 (String.length name);
 182   s;
 183 ;;
 184
 185 let sendintern sock s onlyifexists f =
 186   let s = internreq s onlyifexists in
 187   sendwithrep sock s f;
 188 ;;
 189
 190 let createwindowreq wid parent x y w h bw mask =
 191   let s = "\001\000\009\000wwwwppppxxyywwhhbwccvvvvmmmmeeee" in
 192   w32 s 4 wid;
 193   w32 s 8 parent;
 194   w16 s 12 x;
 195   w16 s 14 y;
 196   w16 s 16 w;
 197   w16 s 18 h;
 198   w16 s 20 bw;
 199   w16 s 22 1;
 200   w32 s 24 0;
 201   w32 s 28 0x800;                       (* eventmask *)
 202   w32 s 32 mask;
 203   s;
 204 ;;
 205
 206 let mapreq wid =
 207   let s = "\008u\002\000wwww" in
 208   w32 s 4 wid;
 209   s;
 210 ;;
 211
 212 let getkeymapreq first count =
 213   let s = "\101u\002\000fcuu" in
 214   w8 s 4 first;
 215   w8 s 5 count;
 216   s;
 217 ;;
 218
 219 let changepropreq wid prop typ format props =
 220   let s = "\018\000llwwwwppppttttfuuuLLLL" in
 221   let s = padcat s props in
 222   w16 s 2 (String.length s / 4);
 223   w32 s 4 wid;
 224   w32 s 8 prop;
 225   w32 s 12 typ;
 226   w8 s 16 format;
 227   let ful = String.length props / (match format with
 228     | 8 -> 1
 229     | 16 -> 2
 230     | 32 -> 4
 231     | n -> error "no idea what %d means" n)
 232   in
 233   w32 s 20 ful;
 234   s;
 235 ;;
 236
 237 let openfontreq fid name =
 238   let s = "\045ullffffnnuu" in
 239   let s = padcat s name in
 240   w16 s 2 (String.length s / 4);
 241   w32 s 4 fid;
 242   w16 s 8 (String.length name);
 243   s;
 244 ;;
 245
 246 let createglyphcursorreq fid cid cindex =
 247   let s = "\094u\008\000ccccffffffffssmmrrggbbRRGGBB" in
 248   w32 s 4 cid;
 249   w32 s 8 fid;
 250   w32 s 12 fid;
 251   w16 s 16 cindex;
 252   w16 s 18 (cindex+1);
 253   w16 s 20 0;
 254   w16 s 22 0;
 255   w16 s 24 0;
 256   w16 s 26 0xffff;
 257   w16 s 28 0xffff;
 258   w16 s 30 0xffff;
 259   s;
 260 ;;
 261
 262 let mapwindowreq wid =
 263   let s = "\008u\002\000wwww" in
 264   w32 s 4 wid;
 265   s;
 266 ;;
 267
 268 let changewindowattributesreq wid mask attrs =
 269   let s = "\002ullwwwwmmmm" in
 270   let s = padcat s attrs in
 271   w16 s 2 (String.length s / 4);
 272   w32 s 4 wid;
 273   w32 s 8 mask;
 274   s;
 275 ;;
 276
 277 let configurewindowreq wid mask values =
 278   let s = "\012ullwwwwmmuu" in
 279   let s = padcat s values in
 280   w16 s 2 (String.length s / 4);
 281   w32 s 4 wid;
 282   w16 s 8 mask;
 283   s;
 284 ;;
 285
 286 let s32 n =
 287   let s = "1234" in
 288   w32 s 0 n;
 289   s;
 290 ;;
 291
 292 let clientmessage format seq wid typ data =
 293   let s = "\033fsswwwwtttt" in
 294   let s = padcat s data in
 295   w8 s 1 format;
 296   w16 s 2 seq;
 297   w32 s 4 wid;
 298   w32 s 8 typ;
 299   s;
 300 ;;
 301
 302 let sendeventreq propagate destwid mask data =
 303   let s = "\025p\011\000wwwwmmmm" in
 304   let s = padcat s data in
 305   w8 s 1 propagate;
 306   w32 s 4 destwid;
 307   w32 s 8 mask;
 308   s;
 309 ;;
 310
 311 let readresp sock =
 312   let resp = readstr sock 32 in
 313   let opcode = r8 resp 0 in
 314   match opcode land lnot 0x80 with
 315   | 0 ->                                (* error *)
 316       let s = resp in
 317       let code = r8 s 1
 318       and serial = r16 s 2
 319       and resid = r32 resp 4
 320       and min = r16 s 8
 321       and maj = r8 s 10 in
 322       error "code=%d serial=%d resid=%#x min=%d maj=%d\n%S"
 323         code serial resid min maj resp;
 324
 325   | 1 ->                                (* response *)
 326       let rep = Queue.pop state.fifo in
 327       rep resp;
 328
 329   | 2 ->                                (* key press *)
 330       if Array.length state.keymap > 0
 331       then
 332         let code = r8 resp  1 in
 333         let mask = r16 resp 28 in
 334         let index = (mask land 1) lxor ((mask land 2) lsr 1) in
 335         let keysym = state.keymap.(code-state.mink).(index) in
 336         vlog "keysym = %x %c" keysym (Char.unsafe_chr keysym);
 337         state.t#key keysym mask;
 338
 339   | 3 ->                                (* key release *)
 340       if Array.length state.keymap > 0
 341       then
 342         let code = r8 resp 1 in
 343         let mask = r16 resp 28 in
 344         let index = (mask land 1) lxor ((mask land 2) lsr 1) in
 345         let keysym = state.keymap.(code-state.mink).(index) in
 346         vlog "release keysym = %x %c mask %#x"
 347           keysym (Char.unsafe_chr keysym) mask
 348
 349   | 4 ->                                (* buttonpress *)
 350       let n = r8 resp 1
 351       and x = r16s resp 24
 352       and y = r16s resp 26
 353       and m = r16 resp 28 in
 354       state.t#mouse n true x y m;
 355       vlog "press %d" n
 356
 357   | 5 ->                                (* buttonrelease *)
 358       let n = r8 resp 1
 359       and x = r16s resp 24
 360       and y = r16s resp 26
 361       and m = r16 resp 28 in
 362       state.t#mouse n false x y m;
 363       vlog "release %d %d %d" n x y
 364
 365   | 6 ->                                (* motion *)
 366       let x = r16s resp 24 in
 367       let y = r16s resp 26 in
 368       let m = r16 resp 28 in
 369       if m = 0
 370       then state.t#pmotion x y
 371       else state.t#motion x y;
 372       vlog "move %dx%d => %d" x y m
 373
 374   | 7 -> vlog "enter"
 375   | 8 -> vlog "leave"
 376   | 18 -> vlog "unmap";
 377
 378   | 19 ->                               (* map *)
 379       if state.w > 0 && state.h > 0
 380       then state.t#reshape state.w state.h;
 381       state.t#display;
 382       vlog "map";
 383
 384   | 12 ->                               (* exposure *)
 385       vlog "exposure";
 386       state.t#display
 387
 388   | 15 ->                               (* visibility *)
 389       let vis = r8 resp 8 in
 390       if vis != 2 then state.t#display;
 391       vlog "visibility %d" vis;
 392
 393   | 34 ->                               (* mapping *)
 394       state.keymap <- [||];
 395       let s = getkeymapreq state.mink (state.maxk-state.mink-1) in
 396       sendwithrep sock s (updkmap sock);
 397
 398   | 33 ->                               (* clientmessage *)
 399       let atom = r32 resp 8 in
 400       if atom = state.protoatom
 401       then (
 402         let atom = r32 resp 12 in
 403         if atom = state.deleatom
 404         then raise Quit;
 405       );
 406       vlog "atom %#x" atom
 407
 408   | 21 ->                               (* reparent *)
 409       vlog "reparent"
 410
 411   | 22 ->                               (* configure *)
 412       vlog "configure";
 413       let w = r16 resp 20
 414       and h = r16 resp 22 in
 415       if w != state.w || h != state.h
 416       then (
 417         state.w <- w;
 418         state.h <- h;
 419         state.t#reshape w h;
 420       );
 421
 422   | n ->
 423       dolog "event %d %S" n resp
 424 ;;
 425
 426 let readresp sock =
 427   let rec loop () =
 428     readresp sock;
 429     if hasdata sock then loop ();
 430   in
 431   loop ();
 432 ;;
 433
 434 let hexstr s =
 435   let b = Buffer.create 16 in
 436   String.iter (fun c ->
 437     Buffer.add_string b (Printf.sprintf "%02x" (Char.code c))) s;
 438   Buffer.contents b;
 439 ;;
 440
 441 let reshape w h =
 442   if state.fs
 443   then
 444     state.fullscreen state.idbase
 445   ;
 446   let s = "wwuuhhuu" in
 447   w32 s 0 w;
 448   w32 s 4 h;
 449   let s = configurewindowreq state.idbase 0x000c s in
 450   vlog "reshape %d %s %d" state.seq (hexstr s) (String.length s);
 451   sendstr s state.sock;
 452 ;;
 453
 454 let setup sock screennum =
 455   let s = readstr sock 2 in
 456   let n = String.length s in
 457   if n != 2
 458   then error "failed to read X connection setup response n=%d" n;
 459   match s.[0] with
 460   | '\000' ->
 461       let reasonlen = r8 s 1 in
 462       let s = readstr sock 6 in
 463       let maj = r16 s 0
 464       and min = r16 s 2
 465       and add = r16 s 4 in
 466       let len = add*4 in
 467       let data = readstr sock len in
 468       let reason = String.sub data 0 reasonlen in
 469       error "X connection failed maj=%d min=%d reason=%S"
 470         maj min reason
 471
 472   | '\002' -> failwith "X connection setup failed: authentication required";
 473
 474   | '\001' ->
 475       let s       = readstr sock 38 in
 476       let maj     = r16 s 0
 477       and min     = r16 s 2
 478       and add     = r16 s 4
 479       and idbase  = r32 s 10
 480       and idmask  = r32 s 14
 481       and vlen    = r16 s 22
 482       and screens = r8 s 26
 483       and formats = r8 s 27
 484       and minkk   = r8 s 32
 485       and maxkk   = r8 s 33 in
 486       let data = readstr sock (4*add-32) in
 487       let vendor = String.sub data 0 vlen in
 488       let pos = ((vlen+3) land lnot 3) + formats*8 in
 489
 490       if screennum >= screens
 491       then error "invalid screen %d, max %d" screennum (screens-1);
 492
 493       let pos =
 494         let s = data in
 495         let rec findscreen n pos = if n = screennum then pos else
 496             let pos =
 497               let ndepths = r8 s (pos+39) in
 498               let rec skipdepths n pos = if n = ndepths then pos else
 499                   let pos =
 500                     let nvisiuals = r16 s (pos+2) in
 501                     pos + nvisiuals*24 + 8
 502                   in
 503                   skipdepths (n+1) pos
 504               in
 505               skipdepths n (pos+40)
 506             in
 507             findscreen (n+1) pos
 508         in
 509         findscreen 0 pos
 510       in
 511       let root = r32 data pos in
 512       let w = r16 data (pos+20)
 513       and h = r16 data (pos+22) in
 514       state.mink <- minkk;
 515       state.maxk <- maxkk;
 516       state.idbase <- idbase;
 517       vlog "vendor = %S, maj=%d min=%d" vendor maj min;
 518       vlog "screens = %d formats = %d" screens formats;
 519       vlog "minkk = %d maxkk = %d" minkk maxkk;
 520       vlog "idbase = %#x idmask = %#x" idbase idmask;
 521       vlog "root=%#x %dx%d" root w h;
 522
 523       let mask = 0
 524         + 0x00000001                    (* KeyPress *)
 525         (* + 0x00000002 *)              (* KeyRelease *)
 526         + 0x00000004                    (* ButtonPress *)
 527         + 0x00000008                    (* ButtonRelease *)
 528         + 0x00000010                    (* EnterWindow *)
 529         + 0x00000020                    (* LeaveWindow *)
 530         + 0x00000040                    (* PointerMotion *)
 531         (* + 0x00000080 *)              (* PointerMotionHint *)
 532         (* + 0x00000100 *)              (* Button1Motion *)
 533         (* + 0x00000200 *)              (* Button2Motion *)
 534         (* + 0x00000400 *)              (* Button3Motion *)
 535         (* + 0x00000800 *)              (* Button4Motion *)
 536         (* + 0x00001000 *)              (* Button5Motion *)
 537         + 0x00002000                    (* ButtonMotion *)
 538         (* + 0x00004000 *)              (* KeymapState *)
 539         + 0x00008000                    (* Exposure *)
 540         + 0x00010000                    (* VisibilityChange *)
 541         + 0x00020000                    (* StructureNotify *)
 542         (* + 0x00040000 *)              (* ResizeRedirect *)
 543         (* + 0x00080000 *)              (* SubstructureNotify *)
 544         (* + 0x00100000 *)              (* SubstructureRedirect *)
 545         (* + 0x00200000 *)              (* FocusChange *)
 546         (* + 0x00400000 *)              (* PropertyChange *)
 547         (* + 0x00800000 *)              (* ColormapChange *)
 548         (* + 0x01000000 *)              (* OwnerGrabButton *)
 549       in
 550       let wid = state.idbase in
 551       let s = createwindowreq wid root 0 0 state.w state.h 0 mask in
 552       sendstr s sock;
 553
 554       let s = mapreq wid in
 555       sendstr s sock;
 556
 557       let s = getkeymapreq state.mink (state.maxk-state.mink) in
 558       sendwithrep sock s (updkmap sock);
 559
 560       sendintern sock "WM_PROTOCOLS" false (fun resp ->
 561         state.protoatom <- r32 resp 8;
 562         sendintern sock "WM_DELETE_WINDOW" false (fun resp ->
 563           state.deleatom <- r32 resp 8;
 564           let s = s32 state.deleatom in
 565           let s = changepropreq wid state.protoatom 4 32 s in
 566           sendstr s sock;
 567         );
 568       );
 569
 570       sendintern sock "WM_CLASS" false (fun resp ->
 571         let atom = r32 resp 8 in
 572         let llpp = "llpp\000llpp\000" in
 573         let s = changepropreq wid atom 31 8 llpp in
 574         sendstr s sock;
 575       );
 576
 577       let s = openfontreq (wid+1) "cursor" in
 578       sendstr s sock;
 579
 580       Array.iteri (fun i glyphindex ->
 581         let s = createglyphcursorreq (wid+1) (wid+2+i) glyphindex in
 582         sendstr s sock;
 583       ) [|34;48;50;58;128;152|];
 584
 585       sendintern sock "UTF8_STRING" false (fun resp ->
 586         state.stringatom <- r32 resp 8;
 587       );
 588
 589       sendintern sock "_NET_WM_STATE" true (fun resp ->
 590         let nwmsatom = r32 resp 8 in
 591         sendintern sock "_NET_WM_STATE_FULLSCREEN" true (fun resp ->
 592           let fsatom = r32 resp 8 in
 593
 594           state.fullscreen <-
 595             (fun wid ->
 596               let data = String.make 20 '\000' in
 597               state.fs <- not state.fs;
 598               w32 data 0 (if state.fs then 1 else 0);
 599               w32 data 4 fsatom;
 600
 601               let cm = clientmessage 32 0 wid nwmsatom data in
 602               let s = sendeventreq 0 root 0x180000 cm in
 603               sendstr s sock;
 604               ()
 605           );
 606         );
 607       );
 608       glx wid
 609
 610   | c ->
 611       error "unknown conection setup response %d" (Char.code c)
 612 ;;
 613
 614 let getauth haddr dnum =
 615   let haddr =
 616     if haddr = "localhost"
 617     then Unix.gethostname ()
 618     else haddr
 619   in
 620   let path = Filename.concat (Sys.getenv "HOME") ".Xauthority" in
 621   let ic = open_in_bin path in
 622   let input_string ic len =
 623     let s = String.create len in
 624     really_input ic s 0 len;
 625     s;
 626   in
 627   let r16 s =
 628     let rb pos = Char.code (String.get s pos) in
 629     (rb 1) lor ((rb 0) lsl 8)
 630   in
 631   let rec find () =
 632     let rs () =
 633       let s = input_string ic 2 in
 634       let n = r16 s in
 635       input_string ic n
 636     in
 637     let family = input_string ic 2 in
 638     let addr = rs () in
 639     let nums = rs () in
 640     let num = int_of_string nums in
 641     let name = rs () in
 642     let data = rs () in
 643
 644     vlog "family %S addr %S(%S) num %d(%d) name %S data %S"
 645       family addr haddr num dnum name data;
 646     if addr = haddr && num = dnum
 647     then name, data
 648     else find ()
 649   in
 650   let name, data =
 651     try find () with _ -> "", ""
 652   in
 653   close_in ic;
 654   name, data;
 655 ;;
 656
 657 let init t =
 658   let d = Sys.getenv "DISPLAY" in
 659   let colonpos = String.index d ':' in
 660   let host = String.sub d 0 colonpos in
 661   let dispnum, screennum =
 662     try
 663       let dotpos = String.index_from d (colonpos + 1) '.' in
 664       let disp = String.sub d (colonpos + 1) (dotpos - colonpos - 1) in
 665       let screen = String.sub d (dotpos + 1) (String.length d - dotpos - 1) in
 666       int_of_string disp, int_of_string screen
 667     with Not_found ->
 668       let disp = String.sub d (colonpos + 1) (String.length d - colonpos - 1) in
 669       int_of_string disp, 0
 670   in
 671   let aname, adata = getauth host dispnum in
 672   let fd =
 673     if String.length host = 0 || host = "unix"
 674     then
 675       let addr = Unix.ADDR_UNIX ("/tmp/.X11-unix/X" ^ string_of_int dispnum) in
 676       let fd = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
 677       Unix.connect fd addr;
 678       fd
 679     else
 680       let h = Unix.gethostbyname host in
 681       let addr = h.Unix.h_addr_list.(0) in
 682       let port = 6000 + dispnum in
 683       let fd = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
 684       Unix.connect fd (Unix.ADDR_INET (addr, port));
 685       fd
 686   in
 687   cloexec fd;
 688   let s = "luMMmmnndduu" in
 689   let s = padcat s aname in
 690   let s = padcat s adata in
 691   w16 s 2 11;
 692   w16 s 4 0;
 693   w16 s 6 (String.length aname);
 694   w16 s 8 (String.length adata);
 695   sendstr s fd;
 696   state.sock <- fd;
 697   setup fd screennum;
 698   state.t <- t;
 699   fd;
 700 ;;
 701
 702 let settitle s =
 703   let s = changepropreq state.idbase 39 state.stringatom 8 s in
 704   sendstr s state.sock;
 705 ;;
 706
 707 let setcursor cursor =
 708   let n =
 709     match cursor with
 710     | CURSOR_INHERIT -> -1
 711     | CURSOR_INFO -> 3
 712     | CURSOR_CYCLE -> 2
 713     | CURSOR_CROSSHAIR -> 0
 714     | CURSOR_TEXT -> 5
 715   in
 716   let s = s32 (if n = -1 then 0 else state.idbase+2+n) in
 717   let s = changewindowattributesreq state.idbase (*cursor*)0x4000 s in
 718   sendstr s state.sock;
 719 ;;
 720
 721 let fullscreen () =
 722   state.fullscreen state.idbase;
 723 ;;
 724
 725 let withalt mask = mask land 8 != 0;;
 726 let withctrl mask = mask land 4 != 0;;
 727 let withshift mask = mask land 1 != 0;;