(failed?) attempt to use Inuit with Format.symbolic_output_buffer

This commit is contained in:
cqc
2021-10-13 07:34:52 -05:00
parent f3d52bc506
commit 4ec076826c
3 changed files with 984 additions and 149 deletions

1
dune
View File

@ -58,6 +58,7 @@
zed zed
lambda-term lambda-term
irmin-unix irmin-unix
inuit
irc-client irc-client
irc-client-lwt irc-client-lwt
irc-client-unix irc-client-unix

1085
human.ml

File diff suppressed because it is too large Load Diff

47
irc.ml
View File

@ -22,25 +22,22 @@ module Communicator = struct
type channel = type channel =
{ mutable name: string { mutable name: string
; mutable content: msg list ; mutable content: msg list
; mutable sender: string -> unit } ; mutable recv: msg -> unit }
let add_msg (c : channel) msg = c.content <- msg :: c.content let add_msg (c : channel) msg = c.content <- msg :: c.content
type c = {mutable channel: channel; mutable subs: c list} type t = {mutable channel: channel; mutable subs: t list}
type protocol = Irc | Email | Rss | Mublog type protocol = Irc | Email | Rss | Mublog
let make_channel (c : c) ?(sender = fun _ -> ()) name = let make_channel ?(recv = add_msg) name =
c.subs <- let c = {name; content= []; recv= (fun _ -> ())} in
{channel= {name; content= []; sender}; subs= []} :: c.subs {c with recv= recv c}
let make () : c = let make () : t =
let c = let channel = make_channel "top" in
{ name= "top" channel.recv (create_msg "Wecome to the Communicator") ;
; content= [create_msg "Wecome to the Communicator"] channel.recv (create_msg "Currently only IRC is implemented") ;
; sender= (fun _ -> ()) } in {channel; subs= []}
c.sender <- (fun s -> c.content <- create_msg s :: c.content) ;
c.sender "Currently only IRC is implemented" ;
{channel= c; subs= []}
type connection = unit Lwt.t type connection = unit Lwt.t
@ -48,7 +45,7 @@ module Communicator = struct
module C = Irc_client_tls module C = Irc_client_tls
module M = Irc_message module M = Irc_message
let connection (c : c) server port nick channels : unit Lwt.t = let connection (c : t) server port nick channels : unit Lwt.t =
let add_msg cn str = add_msg cn.channel (create_msg str) in let add_msg cn str = add_msg cn.channel (create_msg str) in
C.reconnect_loop ~after:30 C.reconnect_loop ~after:30
~connect:(fun () -> ~connect:(fun () ->
@ -88,12 +85,22 @@ module Communicator = struct
end end
module Panel = struct module Panel = struct
let panel c = let panel (c : t) =
Panel.prettyprint ~height:20. ~tag:"Communicator" (fun pp -> let open Panel in
F.pf pp " <><><> COMMUNICATOR <><><> @.@." ; let te = Textedit.make "" () in
List.iter Textedit.panel ~height:20. te
(fun msg -> F.pf pp "[%s] %s@." msg.time msg.content) >>= fun p ->
(List.rev c.channel.content) ) Lwt.return
{ p with
act=
(fun panel events ->
Textedit.clear te ;
List.iter
(fun m ->
Textedit.insert te
(F.str "[%s] %s\n" m.time m.content) )
c.channel.content ;
p.act panel events ) }
end end
end end