Unified · Split
| @@ -26,122 +26,66 @@ external glxcompleteinit : unit -> unit = "ml_glxcompleteinit" · 25 unmodified lines | |||
| 26 | external swapb : unit -> unit = "ml_swapb" | 26 | external swapb : unit -> unit = "ml_swapb" |
| 27 | external setcursor : cursor -> unit = "ml_setcursor" | 27 | external setcursor : cursor -> unit = "ml_setcursor" |
| 28 | 28 | ||
| 29 | let onot = object | 29 | module S = struct |
| 30 | method display = () | 30 | type fs = |
| 31 | method map _ = () | 31 | | NoFs |
| 32 | method expose = () | 32 | | Fs of (int * int * int * int) |
| 33 | method visible _ = () | 33 | and keycode = int |
| 34 | method reshape _ _ = () | 34 | |
| 35 | method mouse _ _ _ _ _ = () | 35 | let mink = ref max_int |
| 36 | method motion _ _ = () | 36 | let maxk = ref min_int |
| 37 | method pmotion _ _ = () | 37 | let keymap = ref E.a |
| 38 | method key _ _ = () | 38 | let fifo = ref (Queue.create ()) |
| 39 | method enter _ _ = () | 39 | let seq = ref 0 |
| 40 | method leave = () | 40 | let protoatom = ref ~-1 |
| 41 | method winstate _ = () | 41 | let deleatom = ref ~-1 |
| 42 | method quit : 'a. 'a = exit 0 | 42 | let nwmsatom = ref ~-1 |
| 43 | method scroll _ _ = () | 43 | let maxvatom = ref ~-1 |
| 44 | method zoom _ _ _ = () | 44 | let maxhatom = ref ~-1 |
| 45 | method opendoc _ = () | 45 | let fulsatom = ref ~-1 |
| 46 | end | 46 | let idbase = ref ~-1 |
| 47 | 47 | let wid = ref ~-1 | |
| 48 | class type t = | 48 | let fid = ref ~-1 |
| 49 | object | 49 | let fullscreen = ref (fun _ -> ()) |
| 50 | method display : unit | 50 | let setwmname = ref (fun _ -> ()) |
| 51 | method map : bool -> unit | 51 | let actwin = ref (fun _ -> ()) |
| 52 | method expose : unit | 52 | let sock = ref Unix.stdin |
| 53 | method visible : visiblestate -> unit | 53 | let x = ref ~-1 |
| 54 | method reshape : int -> int -> unit | 54 | let y = ref ~-1 |
| 55 | method mouse : int -> bool -> int -> int -> int -> unit | 55 | let w = ref ~-1 |
| 56 | method motion : int -> int -> unit | 56 | let h = ref ~-1 |
| 57 | method pmotion : int -> int -> unit | 57 | let fs = ref NoFs |
| 58 | method key : int -> int -> unit | 58 | let stringatom = ref 31 |
| 59 | method enter : int -> int -> unit | 59 | let curcurs = ref CURSOR_TEXT |
| 60 | method leave : unit | 60 | let capslmask = ref 0 |
| 61 | method winstate : winstate list -> unit | 61 | let numlmask = ref 0 |
| 62 | method quit : 'a. 'a | 62 | let levl3mask = ref 0 |
| 63 | method scroll : int -> int -> unit | 63 | let levl5mask = ref 0 |
| 64 | method zoom : float -> int -> int -> unit | 64 | let xkb = ref false |
| 65 | method opendoc : string -> unit | 65 | let fscale = ref 1.0 |
| 66 | end | 66 | let t = ref (object |
| 67 | 67 | method display = () | |
| 68 | type state = | 68 | method map (_:bool) = () |
| 69 | { mutable mink : int | 69 | method expose = () |
| 70 | ; mutable maxk : int | 70 | method visible (_:visiblestate) = () |
| 71 | ; mutable keymap : int array array | 71 | method reshape (_:int) (_:int) = () |
| 72 | ; fifo : (bytes -> unit) Queue.t | 72 | method mouse (_:int) (_:bool) (_:int) (_:int) (_:int) = () |
| 73 | ; mutable seq : int | 73 | method motion (_:int) (_:int) = () |
| 74 | ; mutable protoatom : atom | 74 | method pmotion (_:int) (_:int) = () |
| 75 | ; mutable deleatom : atom | 75 | method key (_:int) (_:int) = () |
| 76 | ; mutable nwmsatom : atom | 76 | method enter (_:int) (_:int) = () |
| 77 | ; mutable maxvatom : atom | 77 | method leave = () |
| 78 | ; mutable maxhatom : atom | 78 | method winstate (_:winstate list) = () |
| 79 | ; mutable fulsatom : atom | 79 | method quit : 'a. 'a = exit 0 |
| 80 | ; mutable idbase : int | 80 | method scroll (_:int) (_:int) = () |
| 81 | ; mutable wid : int | 81 | method zoom (_:float) (_:int) (_:int) = () |
| 82 | ; mutable fid : int | 82 | method opendoc (_:string) = () |
| 83 | ; mutable fullscreen : (int -> unit) | 83 | end) |
| 84 | ; mutable setwmname : (bytes -> unit) | 84 | end |
| 85 | ; mutable actwin : (unit -> unit) | 85 | |
| 86 | ; mutable stringatom : int | 86 | let settitle s = !S.setwmname (~> s) |
| 87 | ; mutable t : t | 87 | let fullscreen () = !S.fullscreen !S.wid |
| 88 | ; mutable sock : Unix.file_descr | 88 | let fontsizescale n = float n *. !S.fscale |> truncate |
| 89 | ; mutable x : int | ||
| 90 | ; mutable y : int | ||
| 91 | ; mutable w : int | ||
| 92 | ; mutable h : int | ||
| 93 | ; mutable fs : fs | ||
| 94 | ; mutable curcurs : cursor | ||
| 95 | ; mutable capslmask : int | ||
| 96 | ; mutable numlmask : int | ||
| 97 | ; mutable levl3mask : int | ||
| 98 | ; mutable levl5mask : int | ||
| 99 | ; mutable xkb : bool | ||
| 100 | ; mutable fscale : float | ||
| 101 | } | ||
| 102 | and fs = | ||
| 103 | | NoFs | ||
| 104 | | Fs of (int * int * int * int) | ||
| 105 | and keycode = int | ||
| 106 | |||
| 107 | let state = | ||
| 108 | { mink = max_int | ||
| 109 | ; maxk = min_int | ||
| 110 | ; keymap = E.a | ||
| 111 | ; fifo = Queue.create () | ||
| 112 | ; seq = 0 | ||
| 113 | ; protoatom = -1 | ||
| 114 | ; deleatom = -1 | ||
| 115 | ; nwmsatom = -1 | ||
| 116 | ; maxvatom = -1 | ||
| 117 | ; maxhatom = -1 | ||
| 118 | ; fulsatom = -1 | ||
| 119 | ; idbase = -1 | ||
| 120 | ; wid = -1 | ||
| 121 | ; fid = -1 | ||
| 122 | ; fullscreen = (fun _ -> ()) | ||
| 123 | ; setwmname = (fun _ -> ()) | ||
| 124 | ; actwin = (fun _ -> ()) | ||
| 125 | ; sock = Unix.stdin | ||
| 126 | ; t = onot | ||
| 127 | ; x = -1 | ||
| 128 | ; y = -1 | ||
| 129 | ; w = -1 | ||
| 130 | ; h = -1 | ||
| 131 | ; fs = NoFs | ||
| 132 | ; stringatom = 31 | ||
| 133 | ; curcurs = CURSOR_TEXT | ||
| 134 | ; capslmask = 0 | ||
| 135 | ; numlmask = 0 | ||
| 136 | ; levl3mask = 0 | ||
| 137 | ; levl5mask = 0 | ||
| 138 | ; xkb = false | ||
| 139 | ; fscale = 1.0 | ||
| 140 | } | ||
| 141 | |||
| 142 | let settitle s = state.setwmname (~> s) | ||
| 143 | let fullscreen () = state.fullscreen state.wid | ||
| 144 | let fontsizescale n = float n *. state.fscale |> truncate | ||
| 145 | 89 | ||
| 146 | let ordermagic = 'l' | 90 | let ordermagic = 'l' |
| 147 | let metamask = 0x40 | 91 | let metamask = 0x40 |
| @@ -166,7 +110,7 @@ let readstr sock n = · 18 unmodified lines | |||
| 166 | let rec loop pos n = | 110 | let rec loop pos n = |
| 167 | let m = tempfailureretry (Unix.read sock s pos) n in | 111 | let m = tempfailureretry (Unix.read sock s pos) n in |
| 168 | if m = 0 | 112 | if m = 0 |
| 169 | then state.t#quit; | 113 | then !S.t#quit; |
| 170 | if n != m | 114 | if n != m |
| 171 | then ( | 115 | then ( |
| 172 | ignore (tempfailureretry (Unix.select [sock] [] []) 0.01); | 116 | ignore (tempfailureretry (Unix.select [sock] [] []) 0.01); |
| @@ -178,8 +122,8 @@ let readstr sock n = · 5 unmodified lines | |||
| 178 | 122 | ||
| 179 | let sendstr1 s pos len sock = | 123 | let sendstr1 s pos len sock = |
| 180 | let s = Bytes.unsafe_to_string s in | 124 | let s = Bytes.unsafe_to_string s in |
| 181 | vlog "%d <= %S" state.seq s; | 125 | vlog "%d <= %S" !S.seq s; |
| 182 | state.seq <- state.seq + 1; | 126 | S.seq := !S.seq + 1; |
| 183 | let n = tempfailureretry (Unix.write_substring sock s pos) len in | 127 | let n = tempfailureretry (Unix.write_substring sock s pos) len in |
| 184 | if n != len | 128 | if n != len |
| 185 | then error "send %d returned %d" len n | 129 | then error "send %d returned %d" len n |
| @@ -193,7 +137,7 @@ let updkmap sock resp = · 7 unmodified lines | |||
| 193 | else E.b | 137 | else E.b |
| 194 | in | 138 | in |
| 195 | let m = len / syms in | 139 | let m = len / syms in |
| 196 | state.keymap <- Array.make_matrix state.maxk syms 0xffffff; | 140 | S.keymap := Array.make_matrix !S.maxk syms 0xffffff; |
| 197 | let rec loop i = | 141 | let rec loop i = |
| 198 | if i != m | 142 | if i != m |
| 199 | then | 143 | then |
| @@ -202,7 +146,7 @@ let updkmap sock resp = · 2 unmodified lines | |||
| 202 | if l != syms | 146 | if l != syms |
| 203 | then | 147 | then |
| 204 | let v = r32 data k in | 148 | let v = r32 data k in |
| 205 | state.keymap.(i).(l) <- v; | 149 | !S.keymap.(i).(l) <- v; |
| 206 | loop2 (k+4) (l+1) | 150 | loop2 (k+4) (l+1) |
| 207 | in | 151 | in |
| 208 | loop2 k 0; | 152 | loop2 k 0; |
| @@ -233,16 +177,16 @@ let updmodmap sock resp = · 24 unmodified lines | |||
| 233 | modmap.(l).(m) <- code; | 177 | modmap.(l).(m) <- code; |
| 234 | if l = 1 | 178 | if l = 1 |
| 235 | then ( | 179 | then ( |
| 236 | let ki = code - state.mink in | 180 | let ki = code - !S.mink in |
| 237 | if ki >= 0 | 181 | if ki >= 0 |
| 238 | then | 182 | then |
| 239 | let a = state.keymap.(ki) in | 183 | let a = !S.keymap.(ki) in |
| 240 | let rec capsloop i = | 184 | let rec capsloop i = |
| 241 | if not (i = Array.length a || i > 3) | 185 | if not (i = Array.length a || i > 3) |
| 242 | then | 186 | then |
| 243 | let s = a.(i) in | 187 | let s = a.(i) in |
| 244 | if s = 0xffe5 | 188 | if s = 0xffe5 |
| 245 | then state.capslmask <- 2 | 189 | then S.capslmask := 2 |
| 246 | else capsloop (i+1) | 190 | else capsloop (i+1) |
| 247 | in | 191 | in |
| 248 | capsloop 0; | 192 | capsloop 0; |
| @@ -250,18 +194,18 @@ let updmodmap sock resp = · 1 unmodified line | |||
| 250 | else ( | 194 | else ( |
| 251 | if l > 3 | 195 | if l > 3 |
| 252 | then | 196 | then |
| 253 | let ki = code - state.mink in | 197 | let ki = code - !S.mink in |
| 254 | if ki >= 0 | 198 | if ki >= 0 |
| 255 | then | 199 | then |
| 256 | let a = state.keymap.(ki) in | 200 | let a = !S.keymap.(ki) in |
| 257 | let rec lloop i = | 201 | let rec lloop i = |
| 258 | if not (i = Array.length a || i > 3) | 202 | if not (i = Array.length a || i > 3) |
| 259 | then | 203 | then |
| 260 | let s = a.(i) in | 204 | let s = a.(i) in |
| 261 | match s with | 205 | match s with |
| 262 | | 0xfe03 -> state.levl3mask <- 1 lsl l | 206 | | 0xfe03 -> S.levl3mask := 1 lsl l |
| 263 | | 0xfe11 -> state.levl5mask <- 1 lsl l | 207 | | 0xfe11 -> S.levl5mask := 1 lsl l |
| 264 | | 0xff7f -> state.numlmask <- 1 lsl l | 208 | | 0xff7f -> S.numlmask := 1 lsl l |
| 265 | | _ -> lloop (i+1) | 209 | | _ -> lloop (i+1) |
| 266 | in | 210 | in |
| 267 | lloop 0; | 211 | lloop 0; |
| @@ -274,7 +218,7 @@ let updmodmap sock resp = · 6 unmodified lines | |||
| 274 | loop 0 | 218 | loop 0 |
| 275 | 219 | ||
| 276 | let sendwithrep sock s f = | 220 | let sendwithrep sock s f = |
| 277 | Queue.push f state.fifo; | 221 | Queue.push f !S.fifo; |
| 278 | sendstr1 s 0 (Bytes.length s) sock | 222 | sendstr1 s 0 (Bytes.length s) sock |
| 279 | 223 | ||
| 280 | let padcat b1 b2 = | 224 | let padcat b1 b2 = |
| @@ -416,9 +360,9 @@ let getkeysym pkpk code mask = · 135 unmodified lines | |||
| 416 | if (pkpk >= 0xff80 && pkpk <= 0xffbd) | 360 | if (pkpk >= 0xff80 && pkpk <= 0xffbd) |
| 417 | || (pkpk >= 0x11000000 && pkpk <= 0x1100ffff) | 361 | || (pkpk >= 0x11000000 && pkpk <= 0x1100ffff) |
| 418 | then ( | 362 | then ( |
| 419 | if mask land state.numlmask != 0 | 363 | if mask land !S.numlmask != 0 |
| 420 | then | 364 | then |
| 421 | let keysym = state.keymap.(code-state.mink).(1) in | 365 | let keysym = !S.keymap.(code - !S.mink).(1) in |
| 422 | if keysym = 0 then pkpk else keysym | 366 | if keysym = 0 then pkpk else keysym |
| 423 | else pkpk | 367 | else pkpk |
| 424 | ) | 368 | ) |
| @@ -426,26 +370,26 @@ let getkeysym pkpk code mask = · 1 unmodified line | |||
| 426 | let shift = | 370 | let shift = |
| 427 | if pkpk land 0xf000 = 0xf000 | 371 | if pkpk land 0xf000 = 0xf000 |
| 428 | then 0 | 372 | then 0 |
| 429 | else (mask land 1) lxor ((mask land state.capslmask) lsr 1) | 373 | else (mask land 1) lxor ((mask land !S.capslmask) lsr 1) |
| 430 | in | 374 | in |
| 431 | let index = | 375 | let index = |
| 432 | if state.xkb && mask land 0x2000 != 0 | 376 | if !S.xkb && mask land 0x2000 != 0 |
| 433 | then shift + 2 | 377 | then shift + 2 |
| 434 | else | 378 | else |
| 435 | let l3 = (mask land state.levl3mask) != 0 in | 379 | let l3 = (mask land !S.levl3mask) != 0 in |
| 436 | let l4 = (mask land state.levl5mask) != 0 in | 380 | let l4 = (mask land !S.levl5mask) != 0 in |
| 437 | shift + | 381 | shift + |
| 438 | if l3 then (if l4 then 8 else 4) else (if l4 then 6 else 0) | 382 | if l3 then (if l4 then 8 else 4) else (if l4 then 6 else 0) |
| 439 | in | 383 | in |
| 440 | let keysym = state.keymap.(code-state.mink).(index) in | 384 | let keysym = !S.keymap.(code - !S.mink).(index) in |
| 441 | if index land 1 = 1 && keysym = 0 | 385 | if index land 1 = 1 && keysym = 0 |
| 442 | then state.keymap.(code-state.mink).(index - 1) | 386 | then !S.keymap.(code - !S.mink).(index - 1) |
| 443 | else keysym | 387 | else keysym |
| 444 | ) | 388 | ) |
| 445 | 389 | ||
| 446 | let getkeysym code mask = | 390 | let getkeysym code mask = |
| 447 | let pkpk = state.keymap.(code-state.mink).(0) in | 391 | let pkpk = !S.keymap.(code - !S.mink).(0) in |
| 448 | if state.xkb && pkpk lsr 8 = 0xfe (* XKB *) | 392 | if !S.xkb && pkpk lsr 8 = 0xfe (* XKB *) |
| 449 | then 0 | 393 | then 0 |
| 450 | else getkeysym pkpk code mask | 394 | else getkeysym pkpk code mask |
| 451 | 395 | ||
| @@ -464,11 +408,11 @@ let readresp sock = · 12 unmodified lines | |||
| 464 | code serial resid min maj (Bytes.unsafe_to_string resp); | 408 | code serial resid min maj (Bytes.unsafe_to_string resp); |
| 465 | 409 | ||
| 466 | | 1 -> (* response *) | 410 | | 1 -> (* response *) |
| 467 | let rep = Queue.pop state.fifo in | 411 | let rep = Queue.pop !S.fifo in |
| 468 | rep resp; | 412 | rep resp; |
| 469 | 413 | ||
| 470 | | 2 -> (* key press *) | 414 | | 2 -> (* key press *) |
| 471 | if Array.length state.keymap > 0 | 415 | if Array.length !S.keymap > 0 |
| 472 | then | 416 | then |
| 473 | let code = r8 resp 1 in | 417 | let code = r8 resp 1 in |
| 474 | let mask = r16 resp 28 in | 418 | let mask = r16 resp 28 in |
| @@ -476,10 +420,10 @@ let readresp sock = · 1 unmodified line | |||
| 476 | vlog "keysym = %x %c mask %#x code %d" | 420 | vlog "keysym = %x %c mask %#x code %d" |
| 477 | keysym (Char.unsafe_chr keysym) mask code; | 421 | keysym (Char.unsafe_chr keysym) mask code; |
| 478 | if keysym != 0 | 422 | if keysym != 0 |
| 479 | then state.t#key keysym mask; | 423 | then !S.t#key keysym mask; |
| 480 | 424 | ||
| 481 | | 3 -> (* key release *) | 425 | | 3 -> (* key release *) |
| 482 | if Array.length state.keymap > 0 | 426 | if Array.length !S.keymap > 0 |
| 483 | then | 427 | then |
| 484 | let code = r8 resp 1 in | 428 | let code = r8 resp 1 in |
| 485 | let mask = r16 resp 28 in | 429 | let mask = r16 resp 28 in |
| @@ -492,7 +436,7 @@ let readresp sock = · 6 unmodified lines | |||
| 492 | and x = r16s resp 24 | 436 | and x = r16s resp 24 |
| 493 | and y = r16s resp 26 | 437 | and y = r16s resp 26 |
| 494 | and m = r16 resp 28 in | 438 | and m = r16 resp 28 in |
| 495 | state.t#mouse n true x y m; | 439 | !S.t#mouse n true x y m; |
| 496 | vlog "press %d" n; | 440 | vlog "press %d" n; |
| 497 | 441 | ||
| 498 | | 5 -> (* buttonrelease *) | 442 | | 5 -> (* buttonrelease *) |
| @@ -500,7 +444,7 @@ let readresp sock = · 1 unmodified line | |||
| 500 | and x = r16s resp 24 | 444 | and x = r16s resp 24 |
| 501 | and y = r16s resp 26 | 445 | and y = r16s resp 26 |
| 502 | and m = r16 resp 28 in | 446 | and m = r16 resp 28 in |
| 503 | state.t#mouse n false x y m; | 447 | !S.t#mouse n false x y m; |
| 504 | vlog "release %d %d %d" n x y; | 448 | vlog "release %d %d %d" n x y; |
| 505 | 449 | ||
| 506 | | 6 -> (* motion *) | 450 | | 6 -> (* motion *) |
| @@ -508,30 +452,30 @@ let readresp sock = · 1 unmodified line | |||
| 508 | let y = r16s resp 26 in | 452 | let y = r16s resp 26 in |
| 509 | let m = r16 resp 28 in | 453 | let m = r16 resp 28 in |
| 510 | if m land 0x1f00 = 0 | 454 | if m land 0x1f00 = 0 |
| 511 | then state.t#pmotion x y | 455 | then !S.t#pmotion x y |
| 512 | else state.t#motion x y; | 456 | else !S.t#motion x y; |
| 513 | vlog "move %dx%d => %d" x y m; | 457 | vlog "move %dx%d => %d" x y m; |
| 514 | 458 | ||
| 515 | | 7 -> (* enter *) | 459 | | 7 -> (* enter *) |
| 516 | let x = r16s resp 24 | 460 | let x = r16s resp 24 |
| 517 | and y = r16s resp 26 in | 461 | and y = r16s resp 26 in |
| 518 | state.t#enter x y; | 462 | !S.t#enter x y; |
| 519 | vlog "enter %d %d" x y; | 463 | vlog "enter %d %d" x y; |
| 520 | 464 | ||
| 521 | | 8 -> (* leave *) | 465 | | 8 -> (* leave *) |
| 522 | state.t#leave; | 466 | !S.t#leave; |
| 523 | 467 | ||
| 524 | | 18 -> (* unmap *) | 468 | | 18 -> (* unmap *) |
| 525 | state.t#map false; | 469 | !S.t#map false; |
| 526 | vlog "unmap"; | 470 | vlog "unmap"; |
| 527 | 471 | ||
| 528 | | 19 -> (* map *) | 472 | | 19 -> (* map *) |
| 529 | state.t#map true; | 473 | !S.t#map true; |
| 530 | vlog "map"; | 474 | vlog "map"; |
| 531 | 475 | ||
| 532 | | 12 -> (* exposure *) | 476 | | 12 -> (* exposure *) |
| 533 | vlog "exposure"; | 477 | vlog "exposure"; |
| 534 | state.t#expose; | 478 | !S.t#expose; |
| 535 | 479 | ||
| 536 | | 15 -> (* visibility *) | 480 | | 15 -> (* visibility *) |
| 537 | let v = r8 resp 8 in | 481 | let v = r8 resp 8 in |
| @@ -544,27 +488,27 @@ let readresp sock = · 6 unmodified lines | |||
| 544 | dolog "unknown visibility %d" v; | 488 | dolog "unknown visibility %d" v; |
| 545 | Unobscured | 489 | Unobscured |
| 546 | in | 490 | in |
| 547 | state.t#visible vis; | 491 | !S.t#visible vis; |
| 548 | vlog "visibility %d" v; | 492 | vlog "visibility %d" v; |
| 549 | 493 | ||
| 550 | | 11 -> (* keymapnotify *) | 494 | | 11 -> (* keymapnotify *) |
| 551 | state.keymap <- E.a; | 495 | S.keymap := E.a; |
| 552 | let s = getkeymapreq state.mink (state.maxk-state.mink-1) in | 496 | let s = getkeymapreq !S.mink (!S.maxk - !S.mink-1) in |
| 553 | sendwithrep sock s (updkmap sock); | 497 | sendwithrep sock s (updkmap sock); |
| 554 | state.capslmask <- 0; | 498 | S.capslmask := 0; |
| 555 | state.levl3mask <- 0; | 499 | S.levl3mask := 0; |
| 556 | state.levl5mask <- 0; | 500 | S.levl5mask := 0; |
| 557 | state.numlmask <- 0; | 501 | S.numlmask := 0; |
| 558 | let s = getmodifiermappingreq () in | 502 | let s = getmodifiermappingreq () in |
| 559 | sendwithrep sock s (updmodmap sock); | 503 | sendwithrep sock s (updmodmap sock); |
| 560 | 504 | ||
| 561 | | 33 -> (* clientmessage *) | 505 | | 33 -> (* clientmessage *) |
| 562 | let atom = r32 resp 8 in | 506 | let atom = r32 resp 8 in |
| 563 | if atom = state.protoatom | 507 | if atom = !S.protoatom |
| 564 | then | 508 | then |
| 565 | let atom = r32 resp 12 in | 509 | let atom = r32 resp 12 in |
| 566 | if atom = state.deleatom | 510 | if atom = !S.deleatom |
| 567 | then state.t#quit; | 511 | then !S.t#quit; |
| 568 | vlog "atom %#x" atom; | 512 | vlog "atom %#x" atom; |
| 569 | 513 | ||
| 570 | | 21 -> (* reparent *) | 514 | | 21 -> (* reparent *) |
| @@ -576,25 +520,25 @@ let readresp sock = · 5 unmodified lines | |||
| 576 | and w = r16 resp 20 | 520 | and w = r16 resp 20 |
| 577 | and h = r16 resp 22 in | 521 | and h = r16 resp 22 in |
| 578 | vlog "configure cur [%d %d %d %d] conf [%d %d %d %d]" | 522 | vlog "configure cur [%d %d %d %d] conf [%d %d %d %d]" |
| 579 | state.x state.y state.w state.h | 523 | !S.x !S.y !S.w !S.h |
| 580 | x y w h; | 524 | x y w h; |
| 581 | if w != state.w || h != state.h | 525 | if w != !S.w || h != !S.h |
| 582 | then state.t#reshape w h; | 526 | then !S.t#reshape w h; |
| 583 | state.w <- w; | 527 | S.w := w; |
| 584 | state.h <- h; | 528 | S.h := h; |
| 585 | state.x <- x; | 529 | S.x := x; |
| 586 | state.y <- y; | 530 | S.y := y; |
| 587 | 531 | ||
| 588 | | 24 -> (* Gravity notify *) | 532 | | 24 -> (* Gravity notify *) |
| 589 | (); | 533 | (); |
| 590 | 534 | ||
| 591 | | 28 -> (* Property notify *) | 535 | | 28 -> (* Property notify *) |
| 592 | let atom = r32 resp 8 in | 536 | let atom = r32 resp 8 in |
| 593 | if atom = state.nwmsatom | 537 | if atom = !S.nwmsatom |
| 594 | then | 538 | then |
| 595 | let s = getpropreq false state.wid atom 4 in | 539 | let s = getpropreq false !S.wid atom 4 in |
| 596 | sendwithrep sock s (fun resp -> | 540 | sendwithrep sock s (fun resp -> |
| 597 | state.fs <- NoFs; | 541 | S.fs := S.NoFs; |
| 598 | let len = r32 resp 4 in | 542 | let len = r32 resp 4 in |
| 599 | let nitems = r32 resp 16 in | 543 | let nitems = r32 resp 16 in |
| 600 | let wsl = | 544 | let wsl = |
| @@ -608,16 +552,15 @@ let readresp sock = · 7 unmodified lines | |||
| 608 | else | 552 | else |
| 609 | let atom = r32 s (i*4) in | 553 | let atom = r32 s (i*4) in |
| 610 | let wsl = | 554 | let wsl = |
| 611 | if atom = state.maxhatom | 555 | if atom = !S.maxhatom |
| 612 | then MaxHorz::wsl | 556 | then MaxHorz::wsl |
| 613 | else ( | 557 | else ( |
| 614 | if atom = state.maxvatom | 558 | if atom = !S.maxvatom |
| 615 | then MaxVert::wsl | 559 | then MaxVert::wsl |
| 616 | else ( | 560 | else ( |
| 617 | if atom = state.fulsatom | 561 | if atom = !S.fulsatom |
| 618 | then ( | 562 | then ( |
| 619 | state.fs <- Fs (state.x, state.y, | 563 | S.fs := S.Fs (!S.x, !S.y, !S.w, !S.h); |
| 620 | state.w, state.h); | ||
| 621 | Fullscreen::wsl | 564 | Fullscreen::wsl |
| 622 | ) | 565 | ) |
| 623 | else wsl | 566 | else wsl |
| @@ -627,7 +570,7 @@ let readresp sock = · 3 unmodified lines | |||
| 627 | in | 570 | in |
| 628 | loop [] 0 | 571 | loop [] 0 |
| 629 | in | 572 | in |
| 630 | state.t#winstate (List.sort compare wsl) | 573 | !S.t#winstate (List.sort compare wsl) |
| 631 | ); | 574 | ); |
| 632 | 575 | ||
| 633 | | n -> dolog "event %d %S" n (Bytes.unsafe_to_string resp) | 576 | | n -> dolog "event %d %S" n (Bytes.unsafe_to_string resp) |
| @@ -644,17 +587,17 @@ let sendstr s ?(pos=0) ?(len=Bytes.length s) sock = · 10 unmodified lines | |||
| 644 | if hasdata sock then readresp sock | 587 | if hasdata sock then readresp sock |
| 645 | 588 | ||
| 646 | let reshape w h = | 589 | let reshape w h = |
| 647 | if state.fs = NoFs | 590 | if !S.fs = S.NoFs |
| 648 | then | 591 | then |
| 649 | let s = Bytes.create 8 in | 592 | let s = Bytes.create 8 in |
| 650 | w32 s 0 w; | 593 | w32 s 0 w; |
| 651 | w32 s 4 h; | 594 | w32 s 4 h; |
| 652 | let s = configurewindowreq state.wid 0x000c s in | 595 | let s = configurewindowreq !S.wid 0x000c s in |
| 653 | sendstr s state.sock; | 596 | sendstr s !S.sock; |
| 654 | else state.fullscreen state.wid | 597 | else !S.fullscreen !S.wid |
| 655 | 598 | ||
| 656 | let activatewin () = | 599 | let activatewin () = |
| 657 | state.actwin () | 600 | !S.actwin () |
| 658 | 601 | ||
| 659 | let syncsendwithrep sock secstowait s f = | 602 | let syncsendwithrep sock secstowait s f = |
| 660 | let completed = ref false in | 603 | let completed = ref false in |
| @@ -679,8 +622,8 @@ let syncsendwithrep sock secstowait s f = · 18 unmodified lines | |||
| 679 | readtillcompletion () | 622 | readtillcompletion () |
| 680 | 623 | ||
| 681 | let mapwin () = | 624 | let mapwin () = |
| 682 | let s = mapreq state.wid in | 625 | let s = mapreq !S.wid in |
| 683 | sendstr s state.sock | 626 | sendstr s !S.sock |
| 684 | 627 | ||
| 685 | let syncsendintern sock secstowait s onlyifexists f = | 628 | let syncsendintern sock secstowait s onlyifexists f = |
| 686 | let s = internreq s onlyifexists in | 629 | let s = internreq s onlyifexists in |
| @@ -753,10 +696,10 @@ let setup disp sock rootwid screennum w h = · 66 unmodified lines | |||
| 753 | and rooth = r16 data (pos+22) | 696 | and rooth = r16 data (pos+22) |
| 754 | and rootdepth = r8 data (pos+38)in | 697 | and rootdepth = r8 data (pos+38)in |
| 755 | 698 | ||
| 756 | state.fscale <- float rooth /. 1440.0; | 699 | S.fscale := float rooth /. 1440.0; |
| 757 | state.mink <- minkk; | 700 | S.mink := minkk; |
| 758 | state.maxk <- maxkk; | 701 | S.maxk := maxkk; |
| 759 | state.idbase <- idbase; | 702 | S.idbase := idbase; |
| 760 | vlog "vendor = %S, maj=%d min=%d" (Bytes.unsafe_to_string vendor) maj min; | 703 | vlog "vendor = %S, maj=%d min=%d" (Bytes.unsafe_to_string vendor) maj min; |
| 761 | vlog "screens = %d formats = %d" screens formats; | 704 | vlog "screens = %d formats = %d" screens formats; |
| 762 | vlog "minkk = %d maxkk = %d" minkk maxkk; | 705 | vlog "minkk = %d maxkk = %d" minkk maxkk; |
| @@ -766,12 +709,12 @@ let setup disp sock rootwid screennum w h = · 3 unmodified lines | |||
| 766 | vlog "visualid = %#x" (r32 data (pos+32)); | 709 | vlog "visualid = %#x" (r32 data (pos+32)); |
| 767 | vlog "root depth = %d" rootdepth; | 710 | vlog "root depth = %d" rootdepth; |
| 768 | 711 | ||
| 769 | let wid = state.idbase in | 712 | let wid = !S.idbase in |
| 770 | let mid = wid+1 in | 713 | let mid = wid+1 in |
| 771 | let fid = mid+1 in | 714 | let fid = mid+1 in |
| 772 | 715 | ||
| 773 | state.wid <- wid; | 716 | S.wid := wid; |
| 774 | state.fid <- fid; | 717 | S.fid := fid; |
| 775 | 718 | ||
| 776 | let vid = glxinit disp wid screennum in | 719 | let vid = glxinit disp wid screennum in |
| 777 | let ndepths = r8 data (pos+39) in | 720 | let ndepths = r8 data (pos+39) in |
| @@ -829,12 +772,12 @@ let setup disp sock rootwid screennum w h = · 51 unmodified lines | |||
| 829 | 772 | ||
| 830 | sendintern | 773 | sendintern |
| 831 | sock (~> "WM_PROTOCOLS") false (fun resp -> | 774 | sock (~> "WM_PROTOCOLS") false (fun resp -> |
| 832 | state.protoatom <- r32 resp 8; | 775 | S.protoatom := r32 resp 8; |
| 833 | sendintern | 776 | sendintern |
| 834 | sock (~> "WM_DELETE_WINDOW") false (fun resp -> | 777 | sock (~> "WM_DELETE_WINDOW") false (fun resp -> |
| 835 | state.deleatom <- r32 resp 8; | 778 | S.deleatom := r32 resp 8; |
| 836 | let s = s32 state.deleatom in | 779 | let s = s32 !S.deleatom in |
| 837 | let s = changepropreq wid state.protoatom 4 32 s in | 780 | let s = changepropreq wid !S.protoatom 4 32 s in |
| 838 | sendstr s sock; | 781 | sendstr s sock; |
| 839 | ); | 782 | ); |
| 840 | ); | 783 | ); |
| @@ -851,7 +794,7 @@ let setup disp sock rootwid screennum w h = · 10 unmodified lines | |||
| 851 | in | 794 | in |
| 852 | if hostname != empty | 795 | if hostname != empty |
| 853 | then | 796 | then |
| 854 | let s = changepropreq wid atom state.stringatom 8 | 797 | let s = changepropreq wid atom !S.stringatom 8 |
| 855 | (~> hostname) in | 798 | (~> hostname) in |
| 856 | sendstr s sock; | 799 | sendstr s sock; |
| 857 | sendintern | 800 | sendintern |
| @@ -864,22 +807,22 @@ let setup disp sock rootwid screennum w h = · 6 unmodified lines | |||
| 864 | ) | 807 | ) |
| 865 | ); | 808 | ); |
| 866 | 809 | ||
| 867 | state.actwin <- (fun () -> | 810 | S.actwin := (fun () -> |
| 868 | let s = Bytes.create 4 in | 811 | let s = Bytes.create 4 in |
| 869 | let s = configurewindowreq wid 0x40 s in | 812 | let s = configurewindowreq wid 0x40 s in |
| 870 | sendstr s state.sock; | 813 | sendstr s !S.sock; |
| 871 | let s = mapreq wid in | 814 | let s = mapreq wid in |
| 872 | sendstr s state.sock; | 815 | sendstr s !S.sock; |
| 873 | ); | 816 | ); |
| 874 | 817 | ||
| 875 | sendintern | 818 | sendintern |
| 876 | sock (~> "_NET_ACTIVE_WINDOW") true (fun resp -> | 819 | sock (~> "_NET_ACTIVE_WINDOW") true (fun resp -> |
| 877 | let atom = r32 resp 8 in | 820 | let atom = r32 resp 8 in |
| 878 | state.actwin <- (fun () -> | 821 | S.actwin := (fun () -> |
| 879 | let data = Bytes.make 20 '\000' in | 822 | let data = Bytes.make 20 '\000' in |
| 880 | let cm = clientmessage 32 0 wid atom data in | 823 | let cm = clientmessage 32 0 wid atom data in |
| 881 | let s = sendeventreq 0 root 0x180000 cm in | 824 | let s = sendeventreq 0 root 0x180000 cm in |
| 882 | sendstr s state.sock; | 825 | sendstr s !S.sock; |
| 883 | ); | 826 | ); |
| 884 | ); | 827 | ); |
| 885 | 828 | ||
| @@ -891,7 +834,7 @@ let setup disp sock rootwid screennum w h = · 5 unmodified lines | |||
| 891 | sendstr s sock; | 834 | sendstr s sock; |
| 892 | ); | 835 | ); |
| 893 | 836 | ||
| 894 | let s = getkeymapreq state.mink (state.maxk-state.mink) in | 837 | let s = getkeymapreq !S.mink (!S.maxk - !S.mink) in |
| 895 | sendwithrep sock s (updkmap sock); | 838 | sendwithrep sock s (updkmap sock); |
| 896 | 839 | ||
| 897 | let s = getmodifiermappingreq () in | 840 | let s = getmodifiermappingreq () in |
| @@ -901,56 +844,56 @@ let setup disp sock rootwid screennum w h = · 3 unmodified lines | |||
| 901 | sock (~> "UTF8_STRING") true (fun resp -> | 844 | sock (~> "UTF8_STRING") true (fun resp -> |
| 902 | let atom = r32 resp 8 in | 845 | let atom = r32 resp 8 in |
| 903 | if atom != 0 | 846 | if atom != 0 |
| 904 | then state.stringatom <- atom; | 847 | then S.stringatom := atom; |
| 905 | ); | 848 | ); |
| 906 | 849 | ||
| 907 | let setwmname s = | 850 | let setwmname s = |
| 908 | let s = changepropreq wid 39 state.stringatom 8 s in | 851 | let s = changepropreq wid 39 !S.stringatom 8 s in |
| 909 | sendstr s state.sock; | 852 | sendstr s !S.sock; |
| 910 | in | 853 | in |
| 911 | state.setwmname <- setwmname; | 854 | S.setwmname := setwmname; |
| 912 | sendintern | 855 | sendintern |
| 913 | sock (~> "_NET_WM_NAME") true (fun resp -> | 856 | sock (~> "_NET_WM_NAME") true (fun resp -> |
| 914 | let atom = r32 resp 8 in | 857 | let atom = r32 resp 8 in |
| 915 | if atom != 0 | 858 | if atom != 0 |
| 916 | then state.setwmname <- (fun s -> | 859 | then S.setwmname := (fun s -> |
| 917 | setwmname s; | 860 | setwmname s; |
| 918 | let s = changepropreq wid atom state.stringatom 8 s in | 861 | let s = changepropreq wid atom !S.stringatom 8 s in |
| 919 | sendstr s state.sock; | 862 | sendstr s !S.sock; |
| 920 | ); | 863 | ); |
| 921 | ); | 864 | ); |
| 922 | 865 | ||
| 923 | sendintern | 866 | sendintern |
| 924 | sock (~> "_NET_WM_STATE") true (fun resp -> | 867 | sock (~> "_NET_WM_STATE") true (fun resp -> |
| 925 | state.nwmsatom <- r32 resp 8; | 868 | S.nwmsatom := r32 resp 8; |
| 926 | if state.nwmsatom != 0 | 869 | if !S.nwmsatom != 0 |
| 927 | then ( | 870 | then ( |
| 928 | sendintern sock (~> "_NET_WM_STATE_MAXIMIZED_VERT") true (fun resp -> | 871 | sendintern sock (~> "_NET_WM_STATE_MAXIMIZED_VERT") true (fun resp -> |
| 929 | state.maxvatom <- r32 resp 8; | 872 | S.maxvatom := r32 resp 8; |
| 930 | ); | 873 | ); |
| 931 | sendintern sock (~> "_NET_WM_STATE_MAXIMIZED_HORZ") true (fun resp -> | 874 | sendintern sock (~> "_NET_WM_STATE_MAXIMIZED_HORZ") true (fun resp -> |
| 932 | state.maxhatom <- r32 resp 8; | 875 | S.maxhatom := r32 resp 8; |
| 933 | ); | 876 | ); |
| 934 | sendintern | 877 | sendintern |
| 935 | sock (~> "_NET_WM_STATE_FULLSCREEN") false (fun resp -> | 878 | sock (~> "_NET_WM_STATE_FULLSCREEN") false (fun resp -> |
| 936 | state.fulsatom <- r32 resp 8; | 879 | S.fulsatom := r32 resp 8; |
| 937 | if state.fulsatom != 0 | 880 | if !S.fulsatom != 0 |
| 938 | then | 881 | then |
| 939 | state.fullscreen <- | 882 | S.fullscreen := |
| 940 | (fun wid -> | 883 | (fun wid -> |
| 941 | let data = Bytes.make 20 '\000' in | 884 | let data = Bytes.make 20 '\000' in |
| 942 | let fs, f = | 885 | let fs, f = |
| 943 | match state.fs with | 886 | match !S.fs with |
| 944 | | NoFs -> Fs (-1, -1, -1, -1), 1 | 887 | | S.NoFs -> S.Fs (-1, -1, -1, -1), 1 |
| 945 | | Fs _ -> NoFs, 0 | 888 | | S.Fs _ -> S.NoFs, 0 |
| 946 | in | 889 | in |
| 947 | w32 data 0 f; | 890 | w32 data 0 f; |
| 948 | w32 data 4 state.fulsatom; | 891 | w32 data 4 !S.fulsatom; |
| 949 | 892 | ||
| 950 | let cm = clientmessage 32 0 wid state.nwmsatom data in | 893 | let cm = clientmessage 32 0 wid !S.nwmsatom data in |
| 951 | let s = sendeventreq 0 root 0x180000 cm in | 894 | let s = sendeventreq 0 root 0x180000 cm in |
| 952 | sendstr s sock; | 895 | sendstr s sock; |
| 953 | state.fs <- fs; | 896 | S.fs := fs; |
| 954 | ); | 897 | ); |
| 955 | ); | 898 | ); |
| 956 | ); | 899 | ); |
| @@ -972,7 +915,7 @@ let setup disp sock rootwid screennum w h = · 15 unmodified lines | |||
| 972 | sock s | 915 | sock s |
| 973 | (fun resp -> | 916 | (fun resp -> |
| 974 | let supported = r8 resp 1 in | 917 | let supported = r8 resp 1 in |
| 975 | state.xkb <- supported != 0 | 918 | S.xkb := supported != 0 |
| 976 | ) | 919 | ) |
| 977 | ); | 920 | ); |
| 978 | ); | 921 | ); |
| @@ -981,8 +924,8 @@ let setup disp sock rootwid screennum w h = · 2 unmodified lines | |||
| 981 | glxcompleteinit (); | 924 | glxcompleteinit (); |
| 982 | let w = r16 resp 16 | 925 | let w = r16 resp 16 |
| 983 | and h = r16 resp 18 in | 926 | and h = r16 resp 18 in |
| 984 | state.w <- w; | 927 | S.w := w; |
| 985 | state.h <- h; | 928 | S.h := h; |
| 986 | ); | 929 | ); |
| 987 | 930 | ||
| 988 | | c -> error "unknown connection setup response %d" (Char.code c) | 931 | | c -> error "unknown connection setup response %d" (Char.code c) |
| @@ -1138,16 +1081,16 @@ let init t w h = · 149 unmodified lines | |||
| 1138 | w16 s 6 (String.length aname); | 1081 | w16 s 6 (String.length aname); |
| 1139 | w16 s 8 (String.length adata); | 1082 | w16 s 8 (String.length adata); |
| 1140 | sendstr1 s 0 (Bytes.length s) fd; | 1083 | sendstr1 s 0 (Bytes.length s) fd; |
| 1141 | state.sock <- fd; | 1084 | S.sock := fd; |
| 1142 | setup d fd 0 screennum w h; | 1085 | setup d fd 0 screennum w h; |
| 1143 | state.t <- t; | 1086 | S.t := t; |
| 1144 | fd, state.w, state.h | 1087 | fd, !S.w, !S.h |
| 1145 | 1088 | ||
| 1146 | let setcursor cursor = | 1089 | let setcursor cursor = |
| 1147 | if cursor != state.curcurs | 1090 | if cursor != !S.curcurs |
| 1148 | then ( | 1091 | then ( |
| 1149 | setcursor cursor; | 1092 | setcursor cursor; |
| 1150 | state.curcurs <- cursor; | 1093 | S.curcurs := cursor; |
| 1151 | ) | 1094 | ) |
| 1152 | 1095 | ||
| 1153 | let xlatt, xlatf = | 1096 | let xlatt, xlatf = |