Compare commits
2 Commits
983fc326d6
...
481870e067
| Author | SHA1 | Date | |
|---|---|---|---|
| 481870e067 | |||
| 8ee3789cb9 |
5
dune
5
dune
@ -15,7 +15,12 @@
|
|||||||
zed
|
zed
|
||||||
lambda-term
|
lambda-term
|
||||||
irmin-unix
|
irmin-unix
|
||||||
|
nottui
|
||||||
nottui-pretty
|
nottui-pretty
|
||||||
|
uuseg.string
|
||||||
|
grenier.trope
|
||||||
|
uutf
|
||||||
|
uucp
|
||||||
ocaml-compiler-libs.common
|
ocaml-compiler-libs.common
|
||||||
ocaml-compiler-libs.bytecomp
|
ocaml-compiler-libs.bytecomp
|
||||||
ocaml-compiler-libs.toplevel))
|
ocaml-compiler-libs.toplevel))
|
||||||
|
|||||||
68
irc.ml
68
irc.ml
@ -244,6 +244,9 @@ module Communicator = struct
|
|||||||
end
|
end
|
||||||
|
|
||||||
module Panel = struct
|
module Panel = struct
|
||||||
|
open Panel
|
||||||
|
open Panel.Ui
|
||||||
|
|
||||||
type viewer =
|
type viewer =
|
||||||
{ step: string
|
{ step: string
|
||||||
; var: view Lwd.var
|
; var: view Lwd.var
|
||||||
@ -355,13 +358,6 @@ module Communicator = struct
|
|||||||
>>= fun t' -> Lwd.set root t' ; Lwt.return_unit )
|
>>= fun t' -> Lwd.set root t' ; Lwt.return_unit )
|
||||||
>>= fun watch -> Lwt.return (watch, root)
|
>>= fun watch -> Lwt.return (watch, root)
|
||||||
|
|
||||||
open Nottui
|
|
||||||
module P = Nottui_pretty
|
|
||||||
|
|
||||||
let string ?attr text = P.ui (Nottui_widgets.string ?attr text)
|
|
||||||
let ( ^^ ) = P.( ^^ )
|
|
||||||
let ( ^/^ ) a b = P.(a ^^ break 1 ^^ b)
|
|
||||||
|
|
||||||
let channelview (store, path) =
|
let channelview (store, path) =
|
||||||
storeview store path
|
storeview store path
|
||||||
>>= fun (_watch, root) ->
|
>>= fun (_watch, root) ->
|
||||||
@ -382,7 +378,7 @@ module Communicator = struct
|
|||||||
v'.node ) in
|
v'.node ) in
|
||||||
Lwd.map sub ~f:(fun sub ->
|
Lwd.map sub ~f:(fun sub ->
|
||||||
Ui.join_y
|
Ui.join_y
|
||||||
(Nottui_widgets.string
|
(Ui.string
|
||||||
( String.make indent '>' ^ " "
|
( String.make indent '>' ^ " "
|
||||||
^ v'.step ) )
|
^ v'.step ) )
|
||||||
sub ) ) in
|
sub ) ) in
|
||||||
@ -433,39 +429,31 @@ module Communicator = struct
|
|||||||
messagelist ch mlist
|
messagelist ch mlist
|
||||||
>>= fun watch -> update_messagelist (Some watch) () in
|
>>= fun watch -> update_messagelist (Some watch) () in
|
||||||
Lwt.async (update_messagelist None) ;
|
Lwt.async (update_messagelist None) ;
|
||||||
let doc =
|
Lwt.return
|
||||||
Lwd.map (Lwd.get mlist) ~f:(fun mlist ->
|
(Lwd.map (Lwd.get mlist) ~f:(fun mlist ->
|
||||||
List.fold_left
|
scroll
|
||||||
|
(List.fold_left
|
||||||
(fun doc ((year, month, day, hour, sec), content) ->
|
(fun doc ((year, month, day, hour, sec), content) ->
|
||||||
F.epr "Communicator.Panel.messagelist ch.content=%s@."
|
F.epr
|
||||||
|
"Communicator.Panel.messagelist ch.content=%s@."
|
||||||
content ;
|
content ;
|
||||||
doc
|
doc
|
||||||
^^ P.group
|
^/^ Ui.string
|
||||||
( string
|
|
||||||
(F.str "%s.%s.%s.%s.%s" year month day hour
|
(F.str "%s.%s.%s.%s.%s" year month day hour
|
||||||
sec )
|
sec )
|
||||||
^^ string " | " ^^ string content )
|
^^ Ui.string " | " ^^ string content )
|
||||||
^^ P.hardline )
|
Ui.empty mlist ) ) )
|
||||||
P.empty mlist ) in
|
|
||||||
Lwt.return
|
|
||||||
(Panel.Nottui.scroll_area (Lwd.map doc ~f:(P.pretty 100)))
|
|
||||||
|
|
||||||
let commview (store, path) =
|
let commview (store, path) =
|
||||||
channelview (store, List.rev (List.tl (List.rev path)))
|
channelview (store, List.rev (List.tl (List.rev path)))
|
||||||
>>= fun (ch, cv) ->
|
>>= fun (ch, cv) ->
|
||||||
messageview ch
|
messageview ch
|
||||||
>>= fun mv ->
|
>>= fun mv ->
|
||||||
Lwt.return
|
Lwt.return (Lwd.map2 cv mv ~f:(fun c m -> join_x c m))
|
||||||
(Nottui_widgets.h_pane (Panel.Nottui.scroll_area cv) mv)
|
|
||||||
|
|
||||||
open Nottui_widgets
|
let panel ({store; view} : Tree.t) : (Event.t -> atom Lwt.t) Lwt.t
|
||||||
|
=
|
||||||
let panel ({store; view} : Tree.t) =
|
commview (store, view) >>= fun cv -> Panel.Ui.panel cv
|
||||||
let base = Lwd.var Nottui_widgets.empty_lwd in
|
|
||||||
commview (store, view)
|
|
||||||
>>= fun cv ->
|
|
||||||
Lwd.set base cv ;
|
|
||||||
Panel.Nottui.panel (Lwd.join (Lwd.get base)) ()
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -481,8 +469,26 @@ let _ =
|
|||||||
>>= fun comm ->
|
>>= fun comm ->
|
||||||
Communicator.Irc.Config.make_connection comm "irc.hackint.org"
|
Communicator.Irc.Config.make_connection comm "irc.hackint.org"
|
||||||
6697 "cqcaml"
|
6697 "cqcaml"
|
||||||
>|= fun () ->
|
>>= fun () ->
|
||||||
Lwt.async (fun () -> Communicator.Irc.connect comm) ;
|
Lwt.async (fun () -> Communicator.Irc.connect comm) ;
|
||||||
F.epr
|
F.epr
|
||||||
"root_actor := std_actor (Communicator.Panel.panel comm)@." ;
|
"root_actor := std_actor (Communicator.Panel.panel comm)@." ;
|
||||||
root_actor := std_actor (Communicator.Panel.panel comm) )
|
Communicator.Panel.panel comm
|
||||||
|
>|= fun f ->
|
||||||
|
root_actor :=
|
||||||
|
std_actor
|
||||||
|
(Lwt.return
|
||||||
|
Panel.
|
||||||
|
{ act=
|
||||||
|
(fun _ events ->
|
||||||
|
Lwt_list.fold_left_s
|
||||||
|
(fun _ ev ->
|
||||||
|
f ev
|
||||||
|
>>= fun i ->
|
||||||
|
Lwt.return (fun s ->
|
||||||
|
( s
|
||||||
|
, ( Gg.Box2.of_pts Gg.V2.zero (snd i)
|
||||||
|
, fst i ) ) ) )
|
||||||
|
Display.pane_empty events )
|
||||||
|
; subpanels= []
|
||||||
|
; tag= "irc" } ) )
|
||||||
|
|||||||
Reference in New Issue
Block a user