Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Page
Library
Module
Module type
Parameter
Class
Class type
Source
inuit_base.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
module Patch = struct type operation = | Remove of int | Insert of string | Replace of int * string | Propertize of int type 'flags t = { offset : int (** Starting at [offset]'th unicode sequence *) ; operation : operation ; text_len : int ; flags : 'flags list (** A list of backend defined [flags]. *) } let utf8_length ?(offset=0) str = let count = ref 0 in for i = offset to String.length str - 1 do let c = Char.code str.[i] in if c land 0xC0 <> 0x80 then incr count done; !count let utf8_offset str ?(offset=0) index = let index = ref index and offset = ref offset and len = String.length str in while !index > 0 && !offset < len do incr offset; decr index; while !offset < len && (Char.code str.[!offset] land 0xC0 = 0x80) do incr offset; done; done; if !index > 0 then raise Not_found; !offset let make ~offset flags operation = { flags = flags; offset = offset; operation; text_len = (match operation with | Insert text | Replace (_,text) -> utf8_length text | _ -> 0 ); } let with_flags flags t = if t.flags == flags then t else {t with flags} let removed t = match t.operation with | Insert _ | Propertize _ -> 0 | Remove n | Replace (n,_) -> n let inserted t = match t.operation with | Insert _ | Replace _ -> t.text_len | Propertize _ | Remove _ -> 0 let inserted_text t = match t.operation with | Insert txt | Replace (_,txt) -> txt | Propertize _ | Remove _ -> "" end type 'flags patch = 'flags Patch.t module Socket = struct type 'msg t = { mutable receive : 'msg -> unit; mutable on_connected : unit -> unit; mutable on_closed : unit -> unit; mutable status : 'msg status; } and 'msg status = | Pending | Connected of 'msg t | Closed type 'a controller = 'a t let make ~receive = { receive = receive; on_connected = ignore; on_closed = ignore; status = Pending; } let send t msg = match t.status with | Connected remote -> remote.receive msg | Pending -> invalid_arg "Inuit.Socket.send: sending data to unconnected pipe" | Closed -> invalid_arg "Inuit.Socket.send: sending data to closed pipe" let close t = match t.status with | Closed -> () | Pending -> t.status <- Closed; t.on_closed (); t.on_connected <- ignore; t.receive <- ignore; t.on_closed <- ignore; | Connected remote -> t.status <- Closed; remote.status <- Closed; t.on_closed (); remote.on_closed (); t.receive <- ignore; t.on_closed <- ignore; remote.receive <- ignore; remote.on_closed <- ignore let connect ~a ~b = match a.status, b.status with | Pending, Pending -> a.status <- Connected b; b.status <- Connected a; a.on_connected (); b.on_connected (); a.on_connected <- ignore; b.on_connected <- ignore | _ -> let to_str = function | Pending -> "pending" | Closed -> "already closed" | Connected _ -> "already connected" in invalid_arg ("Inuit.Socket.connect: pipe a is " ^ to_str a.status ^ "and pipe b is " ^ to_str b.status) let status t = match t.status with | Pending -> `Pending | Connected _ -> `Connected | Closed -> `Closed let set_receive t f = t.receive <- f let set_on_closed t f = t.on_closed <- f let set_on_connected t f = t.on_connected <- f let endpoint socket = socket end type 'msg socket = 'msg Socket.t