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