2 | Punknown
| Plinux
| Posx
| Psun
| Pfreebsd
3 | Pdragonflybsd
| Popenbsd
| Pnetbsd
| Pcygwin
6 let tempfailureretry f a
=
8 try f a
with Unix.Unix_error
(Unix.EINTR
, _
, _
) -> g ()
12 external cloexec
: Unix.file_descr
-> unit = "ml_cloexec";;
13 external hasdata
: Unix.file_descr
-> bool = "ml_hasdata";;
14 external toutf8
: int -> string = "ml_keysymtoutf8";;
15 external mbtoutf8
: string -> string = "ml_mbtoutf8";;
16 external popen
: string -> (Unix.file_descr
* int) list
-> unit = "ml_popen";;
17 external platform
: unit -> platform
= "ml_platform";;
19 let now = Unix.gettimeofday
;;
20 let platform = platform ();;
21 let dolog fmt
= Format.kprintf prerr_endline fmt
;;
24 | Unix.Unix_error
(e
, s
, a
) -> Printf.sprintf
"%s(%s) : %s (%d)"
25 s a
(Unix.error_message e
) (Obj.magic e
)
26 | exn
-> Printexc.to_string exn
;
29 let error fmt
= Printf.kprintf failwith fmt
;;
31 module IntSet
= Set.Make
(struct type t
= int let compare = (-) end);;
33 let emptystr s
= String.length s
= 0;;
34 let nonemptystr s
= String.length s
> 0;;
35 let bound v minv maxv
= max minv
(min maxv v
);;
41 let args = [|sh; "-c"; cmd
|] in
42 let rec std si so se
= function
44 | (fd
, 0) :: rest
-> std fd so se rest
46 Unix.set_close_on_exec fd
;
49 failwith
("unexpected fdn in cygwin popen " ^ string_of_int n
)
51 let si, so
, se
= std Unix.stdin
Unix.stdout
Unix.stderr fda
in
52 ignore
(Unix.create_process
sh args si so se
)
59 type t
= private string
60 val of_string
: string -> t
61 val to_string
: t
-> string
71 let (~
<) = Opaque.of_string;;
72 let (~
>) = Opaque.to_string;;
74 let int_of_string_with_suffix s
=
75 let l = String.length s
in
79 let suffix = Char.lowercase s
.[l-1] in
81 | 'k'
-> String.sub s
0 (l-1), 10
82 | 'm'
-> String.sub s
0 (l-1), 20
83 | '
g'
-> String.sub s
0 (l-1), 30
87 let n = int_of_string
s1 in
88 let m = n lsl shift
in
90 then raise
(Failure
"value too large")
94 let string_with_suffix_of_int n =
98 let units = [(30, "G"); (20, "M"); (10, "K")] in
101 let h = n mod 1000 in
104 then string_of_int
h ^ s
106 let s = Printf.sprintf
"_%03d%s" h s in
112 let rec find = function
114 | (shift
, suffix) :: rest
->
115 if (n land ((1 lsl shift
) - 1)) = 0
116 then prettyint (n lsr shift
) ^
suffix
122 let color_of_string s =
123 Scanf.sscanf
s "%d/%d/%d" (fun r
g b
->
124 (float r
/. 256.0, float g /. 256.0, float b
/. 256.0)
128 let color_to_string (r
, g, b
) =
129 let r = truncate
(r *. 256.0)
130 and g = truncate
(g *. 256.0)
131 and b
= truncate
(b
*. 256.0) in
132 Printf.sprintf
"%d/%d/%d" r g b