diff --git a/dune b/dune index f464241..1a1ba1d 100644 --- a/dune +++ b/dune @@ -2,11 +2,10 @@ (dev (flags (:standard -warn-error -A)))) -(executable - (name main) +(library + (name human) (modes byte) - (modules main) - (link_flags (-linkall)) + (modules human) (libraries topinf lwt_ppx @@ -26,6 +25,8 @@ (modes byte) (modules irc) (libraries + human + lwt fmt topinf lwt_ppx diff --git a/main.ml b/human.ml similarity index 83% rename from main.ml rename to human.ml index ce5cc42..487935e 100644 --- a/main.ml +++ b/human.ml @@ -22,8 +22,6 @@ module F = Fmt module Input = struct open CamomileLibrary - open Zed_edit - open CamomileLibrary (** Type of key code. *) type code = @@ -226,7 +224,6 @@ end module Event = struct open Tsdl open CamomileLibrary - open Zed_edit open Input type mouse = int * int @@ -393,8 +390,6 @@ module Display = struct open Tgles2 open Tsdl open Gg - open CamomileLibrary - open Zed_edit open Wall module I = Image module P = Path @@ -418,6 +413,7 @@ module Display = struct (the Wall.image extents) *) type image = box2 * Wall.image type pane = state -> state * image + type actor = (Event.events -> pane Lwt.t) ref let pane_empty s = (s, (Box2.of_pts (Box2.o s.box) (Box2.o s.box), Image.empty)) @@ -505,7 +501,7 @@ module Display = struct Sdl.gl_swap_window frame.sdl_win ; Ok () - let display_frame frame actor = + let display_frame frame (actor : actor) = (* create and fill event list *) let convert_event ev = match Event.event_of_sdlevent ev with @@ -519,18 +515,25 @@ module Display = struct events := !events @ [convert_event ev] done ) ; handle_frame_events frame !events ; - if List.length !events > 0 then + if List.length !events > 0 then ( (* recompute the actor definition with the new events to return a new pane *) - frame.last_pane <- actor !events ; - (* call draw_pane because we should redraw now that we have updated *) - draw_pane frame frame.last_pane + !actor !events + >>= fun p -> + frame.last_pane <- p ; + (* call draw_pane because we should redraw now that we have updated *) + ignore (draw_pane frame frame.last_pane) ; + Lwt.return_unit ) + else Lwt.return_unit - let run frame render () = + let run frame actor () = let frame = get_result frame in Sdl.show_window frame.sdl_win ; - while not frame.quit do - ignore (display_frame frame render) - done ; + let rec loop () = + ignore (display_frame frame actor) ; + Lwt_main.yield () + >>= fun () -> + if not frame.quit then loop () else Lwt.return_unit in + Lwt_main.run (loop ()) ; print_endline "quit" ; Sdl.hide_window frame.sdl_win ; Sdl.gl_delete_context frame.gl ; @@ -660,32 +663,27 @@ end module Panel = struct open Display - open Wall open Gg type t = - { mutable act: t -> Event.events -> t * Display.pane + { mutable act: t -> Event.events -> (t * Display.pane) Lwt.t ; mutable subpanels: t list ; mutable tag: string } - type actor = Event.events -> Display.pane - let blank = - { act= (fun panel _events -> (panel, Display.pane_empty)) + { act= + (fun panel _events -> Lwt.return (panel, Display.pane_empty)) ; subpanels= [] ; tag= "blank pane" } let draw (pane : Display.pane) = - { act= (fun panel _events -> (panel, pane)) + { act= (fun panel _events -> Lwt.return (panel, pane)) ; subpanels= [] ; tag= "draw-pane" } - let actor (panel : t) : Event.events -> Display.pane = - let enclosure = ref panel in - fun events -> - let panel, pane = panel.act !enclosure events in - enclosure := panel ; - pane + let actor (panel : t) : Event.events -> Display.pane Lwt.t = + fun events -> + panel.act panel events >>= fun (_panel, pane) -> Lwt.return pane let filter_events ef p = {p with act= (fun panel events -> p.act panel (ef events))} @@ -694,12 +692,13 @@ module Panel = struct let vbox subpanels = { act= (fun panel events -> - ( panel - , pane_box Box2.tl_pt - (* tl_pt is actually bl_pt in the Wall coordinate system *) - (List.map - (fun subpanel -> snd (subpanel.act subpanel events)) - panel.subpanels ) ) ) + Lwt_list.map_p + (fun subpanel -> + subpanel.act subpanel events + >>= fun (_panel, pane) -> Lwt.return pane ) + panel.subpanels + >>= fun pl -> Lwt.return (panel, pane_box Box2.tl_pt pl) ) + (* tl_pt is actually bl_pt in the Wall coordinate system *) ; subpanels ; tag= "vertical-box" } @@ -707,12 +706,13 @@ module Panel = struct let hbox subpanels = { act= (fun panel events -> - ( panel - , pane_box Box2.br_pt - (* br_pt is actually tr_pt in the Wall coordinate system *) - (List.map - (fun subpanel -> snd (subpanel.act subpanel events)) - panel.subpanels ) ) ) + Lwt_list.map_p + (fun subpanel -> + subpanel.act subpanel events + >>= fun (_panel, pane) -> Lwt.return pane ) + panel.subpanels + >>= fun pl -> Lwt.return (panel, pane_box Box2.br_pt pl) ) + (* br_pt is actually tr_pt in the Wall coordinate system *) ; subpanels ; tag= "horizontal-box" } @@ -720,11 +720,12 @@ module Panel = struct let obox subpanels = { act= (fun panel events -> - ( panel - , pane_box Box2.o - (List.map - (fun subpanel -> snd (subpanel.act subpanel events)) - panel.subpanels ) ) ) + Lwt_list.map_p + (fun subpanel -> + subpanel.act subpanel events + >>= fun (_panel, pane) -> Lwt.return pane ) + panel.subpanels + >>= fun pl -> Lwt.return (panel, pane_box Box2.o pl) ) ; subpanels ; tag= "origin-box" } @@ -843,10 +844,12 @@ module Panel = struct ; out_spaces= (fun n -> add_symbolic_output_item sob (Output_spaces n)) } - let prettyprint ?(height = !g_text_height) fpp = - { act= (fun panel _events -> (panel, draw_pp height fpp)) + let prettyprint ?(height = !g_text_height) ?(tag = "pretty-print") + fpp = + { act= + (fun panel _events -> Lwt.return (panel, draw_pp height fpp)) ; subpanels= [] - ; tag= "pretty-print" } + ; tag } module Textedit = struct let bindings = @@ -963,14 +966,13 @@ module Panel = struct Format.pp_open_hvbox pp 0 ; F.text pp before_cursor ; Format.pp_open_stag pp - Display.( - Cursor (Wall.Color.v 0.99 0.99 0.125 0.3)) ; + (Cursor (Wall.Color.v 0.99 0.99 0.125 0.3)) ; F.pf pp "" ; Format.pp_close_stag pp () ; F.text pp after_cursor ; F.pf pp "@." ; Format.pp_close_box pp () ) in - (panel, draw_textedit) ) + Lwt.return (panel, draw_textedit) ) ; subpanels= [] ; tag= "textedit" } @@ -979,31 +981,34 @@ module Panel = struct = { act= (fun panel _events -> - ( panel - , draw_pp height (fun pp -> - Format.pp_open_hbox pp () ; - F.text pp - (List.fold_left - (fun s x -> Input.to_string_compact x ^ " " ^ s) - "" b.last_keyseq ) ; - F.text pp "-> " ; - F.text pp - ( match b.state with - | Accepted a -> - "Accepted " - ^ List.fold_right - (fun x s -> - s - ^ Input.Bind.( - match x with - | Zed a -> Zed_edit.name_of_action a - | Custom _ -> "Custom") - ^ "; " ) - a "" - | Rejected -> "Rejected" - | Continue _ -> "Continue" ) ; - Format.pp_close_box pp () ; - F.flush pp () ) ) ) + Lwt.return + ( panel + , draw_pp height (fun pp -> + Format.pp_open_hbox pp () ; + F.text pp + (List.fold_left + (fun s x -> + Input.to_string_compact x ^ " " ^ s ) + "" b.last_keyseq ) ; + F.text pp "-> " ; + F.text pp + ( match b.state with + | Accepted a -> + "Accepted " + ^ List.fold_right + (fun x s -> + s + ^ Input.Bind.( + match x with + | Zed a -> + Zed_edit.name_of_action a + | Custom _ -> "Custom") + ^ "; " ) + a "" + | Rejected -> "Rejected" + | Continue _ -> "Continue" ) ; + Format.pp_close_box pp () ; + F.flush pp () ) ) ) ; subpanels= [] ; tag= "binding-state" } end @@ -1038,7 +1043,7 @@ module Panel = struct | Some text -> Textedit.insert me.te text ; (hbox panel.subpanels).act panel events - | None -> (panel, Display.pane_empty) + | None -> Lwt.return (panel, Display.pane_empty) (* don't draw anything if modal isn't active *) ) ; subpanels= [ prettyprint (fun pp -> F.text pp me.prompt) @@ -1063,8 +1068,8 @@ module Toplevel = struct let init () = let sob = Format.make_symbolic_output_buffer () in - let ppf = Format.formatter_of_symbolic_output_buffer sob in - {eval= Topinf.init ppf; res= sob} + Topinf.ppf := Format.formatter_of_symbolic_output_buffer sob ; + {eval= !Topinf.eval; res= sob} let eval t str = let ppf = Format.formatter_of_symbolic_output_buffer t.res in @@ -1094,7 +1099,8 @@ module Store = struct { store: Istore.t ; mutable view: Istore.key ; mutable selection: Istore.key - ; mutable editmode: bool } + ; mutable editmode: bool + ; sob: Format.symbolic_output_buffer } let make_storeview ?(path = []) storepath branch = Lwt_main.run @@ -1109,7 +1115,8 @@ module Store = struct { store ; view ; selection= Istore.Key.v [fst (List.hd viewlist)] - ; editmode= false } ) + ; editmode= false + ; sob= Format.make_symbolic_output_buffer () } ) let directives (top : Toplevel.t) sv = let dir_use_key key_lid = @@ -1223,22 +1230,56 @@ module Store = struct >>= function | Some `Node -> Lwt.return_true | _ -> Lwt.return_false ) in + let update_storeview () = + ignore (Format.flush_symbolic_output_buffer sv.sob) ; + let pp = Format.formatter_of_symbolic_output_buffer sv.sob in + let rec draw_levels ?(indent = 0) (sel : Istore.key) + (tree : Istore.tree) : unit Lwt.t = + Istore.Tree.list tree [] + >>= Lwt_list.iteri_s (fun _i (step, node) -> + Format.pp_open_box pp indent ; + if sel = [step] then ( + Format.pp_open_stag pp + (Panel.Cursor (Wall.Color.v 0.99 0.99 0.125 0.3)) ; + F.pf pp "@," ; + Format.pp_close_stag pp () ) ; + Istore.Tree.kind node [] + >>= fun k -> + ( match k with + | Some `Contents -> + F.pf pp "- %s@." step ; Lwt.return_unit + | Some `Node -> + F.pf pp "> %s@." step ; + let subsel = + match Istore.Key.decons sel with + | Some (_tstep, subkey) -> subkey + | None -> [] in + Format.pp_open_vbox pp 0 ; + draw_levels ~indent:(indent + 1) subsel node + >>= fun () -> + Format.pp_close_box pp () ; + Lwt.return_unit + | None -> F.pf pp "ERROR: None" ; Lwt.return_unit ) + >>= fun () -> + Format.pp_close_box pp () ; + Lwt.return_unit ) in + Istore.get_tree sv.store sv.view >>= draw_levels sv.selection + in let update_textedit () = Panel.Textedit.clear te ; - Lwt_main.run - ( Istore.get_tree sv.store sv.view - >>= fun t -> - Istore.Tree.kind t sv.selection - >>= function - | Some `Contents -> - Istore.Tree.get t sv.selection - >>= fun content -> - Panel.Textedit.insert te content ; - Lwt.return_unit - | Some `Node -> - Panel.Textedit.insert te "Node..." ; - Lwt.return_unit - | None -> Lwt.return_unit ) in + Istore.get_tree sv.store sv.view + >>= fun t -> + Istore.Tree.kind t sv.selection + >>= function + | Some `Contents -> + Istore.Tree.get t sv.selection + >>= fun content -> + Panel.Textedit.insert te content ; + Lwt.return_unit + | Some `Node -> + Panel.Textedit.insert te "Node..." ; + Lwt.return_unit + | None -> Lwt.return_unit in let navbinds = let open Input.Bind in let new_contents name content = @@ -1260,7 +1301,8 @@ module Store = struct @@ add [([], Char 's')] [Custom (navigate sv `Next)] @@ add [([], Char 'd')] [Custom (navigate sv `Sub)] @@ add [([], Char 'a')] [Custom (navigate sv `Sup)] - @@ add [([], Char 'e')] + @@ add + [([], Char 'e')] (* enter edit mode *) [ Custom (fun () -> if not (is_node sv.selection) then @@ -1305,19 +1347,20 @@ module Store = struct [([], Char 'x')] (* execute contents/node *) [ Custom (fun () -> - Panel.Modal.start ~prompt:"!!Not implemented!!" - modalstate "" (fun _ -> ()) ) ] + Toplevel.eval top (Panel.Textedit.contents te) ) ] empty in let bindstate = Input.Bind.init navbinds in { act= (fun panel events -> - if + ( if (not sv.editmode) && not (Panel.Modal.is_active modalstate) then ( Input.Bind.process bindstate events ; - update_textedit () ) ; - (Panel.vbox panel.subpanels).act panel events ) + Lwt.join [update_storeview (); update_textedit ()] ) + else Lwt.return_unit ) + >>= fun () -> (Panel.vbox panel.subpanels).act panel events + ) ; subpanels= [ Panel.filter_events (fun ev -> @@ -1325,39 +1368,8 @@ module Store = struct (Panel.Modal.panel modalstate) ; Panel.hbox [ Panel.prettyprint (fun pp -> - let rec draw_levels ?(indent = 0) - (tree : Istore.tree) (sel : Istore.key) = - List.iteri - (fun _i (step, node) -> - Format.pp_open_box pp indent ; - if sel = [step] then ( - Format.pp_open_stag pp - Display.( - Panel.Cursor - (Wall.Color.v 0.99 0.99 0.125 0.3)) ; - F.pf pp "@," ; - Format.pp_close_stag pp () ) ; - ( match - Lwt_main.run (Istore.Tree.kind node []) - with - | Some `Contents -> F.pf pp "- %s@." step - | Some `Node -> - F.pf pp "> %s@." step ; - let subsel = - match Istore.Key.decons sel with - | Some (_tstep, subkey) -> subkey - | None -> [] in - Format.pp_open_vbox pp 0 ; - draw_levels ~indent:(indent + 1) node - subsel ; - Format.pp_close_box pp () - | None -> F.pf pp "ERROR: None" ) ; - Format.pp_close_box pp () ) - (Lwt_main.run (Istore.Tree.list tree [])) in - let root = - Lwt_main.run (Istore.get_tree sv.store sv.view) - in - draw_levels root sv.selection ) + Panel.format_symbolic_output_buffer pp + (Format.get_symbolic_output_buffer sv.sob) ) ; Panel.vbox [ Panel.filter_events (fun ev -> if sv.editmode then ev else []) @@ -1375,109 +1387,18 @@ module Store = struct ; tag= "store-editor" } end -open Wall -open Gg -module I = Image -module P = Path -module Text = Wall_text +let std_actor root_panel = + Panel.actor + (Panel.obox + [ Panel.draw (fun (s : Display.state) -> + (s, Display.fill_box (Display.gray 0.125) s.box) ) + ; root_panel ] ) -type top = - { te: Panel.Textedit.t - ; res: Format.symbolic_output_buffer - ; mutable eval: Topinf.evalenv option - ; mutable path: string list - ; mutable histpath: string list - ; storeview: Store.storeview } +let root_actor = ref (std_actor (Store.editor "../rootstore")) -let make_top storepath ?(branch = "current") () = - let t = - { te= Panel.Textedit.make "" () - ; res= Format.make_symbolic_output_buffer () - ; eval= None - ; path= ["init"] - ; histpath= ["history"] - ; storeview= Store.make_storeview storepath branch } in - Topinf.ppf := Format.formatter_of_symbolic_output_buffer t.res ; - (* Format.pp_set_formatter_out_functions Format.std_formatter - (out_funs_of_sob t.res) ;*) - Panel.Textedit.insert t.te - (Lwt_main.run (Store.Istore.get t.storeview.store t.path)) ; - t - -let top_panel (t : top) = - let ppf = Format.formatter_of_symbolic_output_buffer t.res in - Topinf.ppf := ppf ; - let eval = - match t.eval with - (* HACK use Lazy.? *) - | None -> - let e = - match !Topinf.eval with - | Some e -> e - | None -> Topinf.init ppf in - t.eval <- Some e ; - e - | Some e -> e in - let eval () = - try - ignore - (Lwt_main.run - ( Store.Istore.tree t.storeview.store - >>= fun tree -> - Store.Istore.Tree.add tree - (t.histpath @ ["input"]) - (Panel.Textedit.contents t.te) ) ) ; - ignore (Format.flush_symbolic_output_buffer t.res) ; - eval ppf (Panel.Textedit.contents t.te ^ ";;") ; - (*HACK to prevent getting stuck in parser*) - let b = Buffer.create 69 in - Panel.format_symbolic_output_buffer - (Format.formatter_of_buffer b) - (Format.get_symbolic_output_buffer t.res) ; - ignore - (Lwt_main.run - ( Store.Istore.tree t.storeview.store - >>= fun tree -> - Store.Istore.Tree.add tree - (t.histpath @ ["output"]) - (Buffer.contents b) ) ) ; - ignore - (Lwt_main.run - (Store.Istore.set_exn t.storeview.store - ~info:(Irmin_unix.info "history") - t.path - (Panel.Textedit.contents t.te) ) ) ; - Panel.Textedit.clear t.te - with e -> - F.pf ppf "Exception in pane_top//eval@." ; - Location.report_exception ppf e ; - F.epr "Exception in pane_top//eval@." in - t.te.keybind.bindings <- - Input.( - Bind.add - [([Ctrl], Code Enter)] - Bind.[Custom eval] - t.te.keybind.bindings) ; - Panel.( - vbox - [ Textedit.panel t.te - ; prettyprint (fun pp -> - Format.pp_open_hovbox pp 0 ; - format_symbolic_output_buffer pp - (Format.get_symbolic_output_buffer t.res) ; - Format.pp_close_box pp () ; - F.flush pp () ) (*; draw_textedit_input height t.te *) ]) - -(*let top_1 = make_top "../rootstore" () *) - -let () = - let actor = - Panel.actor - (Panel.obox - [ Panel.draw (fun (s : Display.state) -> - (s, Display.fill_box (Display.gray 0.125) s.box) ) - ; Store.editor "../rootstore" ] ) in - Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) actor) () +let start () = + Display.( + run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) root_actor ()) (* Implement the "window management" as just toplevel defined functions that manipulate the window tree *) diff --git a/init.ml b/init.ml index a58f6b3..f124c00 100644 --- a/init.ml +++ b/init.ml @@ -6,11 +6,13 @@ let print_directives () = Format.printf "directive_info_table:@."; Hashtbl.iter (fun n _ -> Format.printf "\t%s@." n) Topinf.directive_info_table;; -#directory "+compiler-libs";; +(*#directory "+compiler-libs";; *) let print_modules () = Format.printf "Env.fold_modules !Topinf.toplevel_env :\n"; Env.fold_modules (fun modname _ _ () -> Format.printf "\t%s@." modname) None !Topinf.toplevel_env ();; +(*print_modules ();;*) -#use_silently "main.ml";; +#use_silently "human.ml";; +start ();; diff --git a/irc.ml b/irc.ml index dccad5c..44ade20 100644 --- a/irc.ml +++ b/irc.ml @@ -1,109 +1,109 @@ (* - when all you can do is type, making things more complicated than a list is hard? we need to design this somehow before implementing it really the graphical drawing / window management funcitons i think at this point. - features: - message drafts? more like, if you send too many messages to someone all at once it will hold them so you can respond later and not flood people....... - i mean really what you want is an editable stream, so you can stage messages for later - because i mean, if this is a bicycle, and you can make it however you want, you can just fuck with the conversation thread with computer assistance instaed of just relying on your memory. - *) open Lwt -module C = Irc_client_tls -module M = Irc_message +open Lwt_react +module F = Fmt -let host = ref "irc.hackint.org" -let port = ref 6697 -let nick = ref "cqcaml" -let channel = ref "#freeside" -let message = "Hello, world! This is a test from ocaml-irc-client" +module Communicator = struct + type msg = {content: string; time: string; mutable seen: bool} -let output_channel_of_ppf ppf = - Lwt_io.make ~mode:Output (fun b o l -> - let s = String.sub (Lwt_bytes.to_string b) o l in - Fmt.pf ppf "%s" s ; - Lwt.return (String.length s) ) + let create_msg ?(time = "") content = + {content; time; seen= false} -let callback connection result = - match result with - | Result.Ok ({M.command= M.Other _; _} as msg) -> - Lwt_io.printf "Got unknown message: %s\n" (M.to_string msg) - >>= fun () -> Lwt_io.flush Lwt_io.stdout - | Result.Ok ({M.command= M.PRIVMSG (_target, data); _} as msg) -> - Lwt_io.printf "Got message: %s\n" (M.to_string msg) - >>= fun () -> - Lwt_io.flush Lwt_io.stdout - >>= fun () -> - C.send_privmsg ~connection ~target:"cqc" - ~message:("ack: " ^ data) - | Result.Ok msg -> - Lwt_io.printf "Got message: %s\n" (M.to_string msg) - >>= fun () -> Lwt_io.flush Lwt_io.stdout - | Result.Error e -> Lwt_io.printl e + type channel = + { mutable name: string + ; mutable content: msg list + ; mutable sender: string -> unit } -let lwt_main () = - C.reconnect_loop ~after:30 - ~connect:(fun () -> - Lwt_io.printl "Connecting..." - >>= fun () -> - C.connect_by_name ~server:!host ~port:!port ~nick:!nick () ) - ~f:(fun connection -> - Lwt_io.printl "Connected" - >>= fun () -> - Lwt_io.printl "send join msg" - >>= fun () -> - C.send_join ~connection ~channel:!channel - >>= fun () -> - C.send_privmsg ~connection ~target:!channel ~message ) - ~callback () + let add_msg (c : channel) msg = c.content <- msg :: c.content + + type c = {mutable channel: channel; mutable subs: c list} + type protocol = Irc | Email | Rss | Mublog + + let make_channel (c : c) ?(sender = fun _ -> ()) name = + c.subs <- + {channel= {name; content= []; sender}; subs= []} :: c.subs + + let make () : c = + let c = + { name= "top" + ; content= [create_msg "Wecome to the Communicator"] + ; sender= (fun _ -> ()) } in + 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 + + module Irc = struct + module C = Irc_client_tls + module M = Irc_message + + let connection (c : c) server port nick channels : unit Lwt.t = + let add_msg cn str = add_msg cn.channel (create_msg str) in + C.reconnect_loop ~after:30 + ~connect:(fun () -> + Lwt_io.printl "Connecting..." + >>= fun () -> C.connect_by_name ~server ~port ~nick () ) + ~f:(fun connection -> + Lwt_io.printl "Connected" + >>= fun () -> + Lwt_list.iter_p + (fun channel -> + let joiner = C.send_join ~connection ~channel in + (* make_channel c ~sender:(fun s -> + C.send_privmsg ~target:channel ~message:s) channel ; *) + joiner ) + channels ) + ~callback:(fun _connection result -> + match result with + | Result.Ok ({M.command= M.Other _; _} as msg) -> + add_msg c + (F.str "Got unknown message: %s\n" (M.to_string msg)) ; + Lwt.return_unit + | Result.Ok ({M.command= M.PRIVMSG (target, data); _} as msg) + -> + add_msg c + (F.str "Got PRIVMSG: target=%s, data=%s; %s\n" target + data (M.to_string msg) ) ; + Lwt.return_unit + | Result.Ok msg -> + add_msg c (M.to_string msg) ; + Lwt.return_unit + | Result.Error e -> Lwt_io.printl e ) + () + end + + module Panel = struct + let panel c = + Panel.prettyprint ~height:20. ~tag:"Communicator" (fun pp -> + F.pf pp " <><><> COMMUNICATOR <><><> @.@." ; + List.iter + (fun msg -> F.pf pp "[%s] %s@." msg.time msg.content) + c.channel.content ) + end +end let _ = - Lwt_main.run - (Lwt.catch lwt_main (fun e -> - Printf.printf "exception: %s\n" (Printexc.to_string e) ; - exit 1 ) ) + let comm = Communicator.make () in + let hackint = + Communicator.Irc.connection comm "irc.hackint.org" 6697 "cqcaml" + ["#CQC"] in + root_actor := std_actor (Communicator.Panel.panel comm) ; + Lwt.async (fun () -> hackint) -(* ocamlfind ocamlopt -package irc-client.lwt -linkpkg code.ml *) - -(*open Lwt - module C = Irc_client_lwt - - let host = "irc.hackint.org" - let port = 6697 - let realname = "Demo IRC bot" - let nick = "cqcqcqcqc" - let username = nick - let channel = "#freeside" - let message = "Hello, world! This is a test from ocaml-irc-client" - - let callback oc _connection result = - let open Irc_message in - match result with - | Result.Ok msg -> - Fmt.epr "irc msg: msg" ; - Lwt_io.fprintf oc "Got message: %s\n" (to_string msg) - | Result.Error e -> Lwt_io.fprintl oc e - - let lwt_main = - let oc = output_channel_of_ppf !Topinf.ppf in - Lwt_unix.gethostbyname host - >>= fun he -> - C.connect - ~addr:he.Lwt_unix.h_addr_list.(0) - ~port ~username ~mode:0 ~realname ~nick () - >>= fun connection -> - Lwt_io.fprintl oc "Connected" - >>= fun () -> - C.send_join ~connection ~channel - >>= fun () -> - C.send_privmsg ~connection ~target:channel ~message - >>= fun () -> - C.listen ~connection ~callback:(callback oc) () - >>= fun () -> C.send_quit ~connection () - - let _ = Lwt_main.run lwt_main -*) +(** + program starts... + - spawn connections to servers + - these connections will populate the Channel.t in a Channel.tree + + **) diff --git a/komm.opam b/komm.opam deleted file mode 100644 index e69de29..0000000 diff --git a/topinf.ml b/topinf.ml index 858eccb..3e3fe7b 100644 --- a/topinf.ml +++ b/topinf.ml @@ -44,7 +44,7 @@ let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty let ppf = ref Format.std_formatter -let eval = ref None +let eval = ref (fun _ _ -> ()) let getvalue name = try String.Map.find name !toplevel_value_bindings @@ -2398,5 +2398,5 @@ let init ppf = Location.input_phrase_buffer := Some phrase_buffer ; Sys.catch_break true ; run_hooks After_setup ; - eval := Some (eval_fun lb) ; + eval := eval_fun lb ; eval_fun lb diff --git a/topinf.mli b/topinf.mli index 23e15bc..d5685cb 100644 --- a/topinf.mli +++ b/topinf.mli @@ -26,5 +26,5 @@ val add_directive : val directive_info_table : (string, directive_info) Hashtbl.t val ppf : Format.formatter ref -val eval : evalenv option ref +val eval : evalenv ref val eval_value_path : Env.t -> Path.t -> Obj.t