diff --git a/README b/README index 161bbdc..0309d02 100644 --- a/README +++ b/README @@ -2,9 +2,4 @@ - `console/rootstore` must exist at `../rootstore` -$ dune exec ./main.exe - -Type in: -`#use "init.ml"` -Ctrl-Enter runs the command - +$ dune exec ./boot.exe diff --git a/test.ml b/boot.ml similarity index 69% rename from test.ml rename to boot.ml index 936a915..6f0deb2 100644 --- a/test.ml +++ b/boot.ml @@ -1,6 +1,2 @@ - - - - let eval = (Topinf.init Format.std_formatter) Format.std_formatter in -eval "#use \"init.ml\";;"; +eval "#use \"init.ml\";;" diff --git a/dune b/dune index 34b04ab..aa67dd8 100644 --- a/dune +++ b/dune @@ -19,18 +19,24 @@ ocaml-compiler-libs.toplevel)) (executable - (name test) + (name boot) (modes byte) - (modules test) + (modules boot) (link_flags (-linkall)) (libraries topinf)) - (library (name topinf) (modes byte) (modules topinf) (libraries fmt + tsdl + tgls.tgles2 + wall + zed + irmin-unix + ocaml-compiler-libs.common + ocaml-compiler-libs.bytecomp ocaml-compiler-libs.toplevel)) diff --git a/init.ml b/init.ml index b9235f6..2900ce7 100644 --- a/init.ml +++ b/init.ml @@ -1,6 +1,7 @@ (* $Id$ -*- tuareg -*- *) -#directory "/home/cqc/p/console/boot/_build/default/.topinf.objs/byte";; +Sys.command "dune top | head -n -1 > .topenv";; (* `head -n -1` to remove the topinf.cma which fuck this shit all up *) +#use ".topenv";; open Topinf;; let print_directives () = Format.printf "directive_info_table:@."; @@ -12,3 +13,4 @@ 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 ();; +#use "main.ml";; diff --git a/main.ml b/main.ml index 0068513..f81cfa9 100644 --- a/main.ml +++ b/main.ml @@ -318,7 +318,7 @@ let simple_text f text (s : Display.state) = let tm = Text.Font.text_measure f text in let br_pt = P2.v (Box2.ox s.box +. tm.width) (Box2.oy s.box +. font_height) in let bextent = Box2.of_pts (Box2.o s.box) br_pt in - let _, (_, redbox) = path_box Color.red bextent s in + (* let _, (_, redbox) = path_box Color.red bextent s in*) ( { s with box = Box2.of_pts (Box2.br_pt bextent) (Box2.max s.box) }, ( bextent, (* I.stack redbox *) @@ -526,6 +526,7 @@ type top = { res : Format.symbolic_output_buffer; mutable eval : Topinf.evalenv option; path : string list; + histpath : string list; storeview : storeview; } @@ -559,11 +560,12 @@ let make_top storepath ?(branch = "current") () = res = Format.make_symbolic_output_buffer (); eval = None; path = [ "init" ]; + histpath = [ "history" ]; storeview = 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); +(* 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);*) let zctx = Zed_edit.context t.te.ze t.te.zc in Zed_edit.insert zctx (Zed_rope.of_string @@ -576,28 +578,29 @@ let draw_top (t : top) height (s : Display.state) = let eval = match t.eval with | None -> - let e = Topinf.init ppf in + let e = match !Topinf.eval with | Some e -> e | None -> Topinf.init ppf in t.eval <- Some e; - e ppf "#use \"init.ml\";;"; + (* e ppf "#use \"init.ml\";;"; *) e | Some e -> e in (* HACK use Lazy.? *) Display.handle_keyevents s.events (function | `Key_up { char = '\r'; mods = [ Ctrl ]; _ } -> - (* HACK overwriting stdout formatter because fucking ocaml/toplevel/topdirs.ml hardcodes it *) - Format.pp_set_formatter_out_functions Format.std_formatter (out_funs_of_sob t.res); - eval ppf (str_of_textedit t.te ^ ";;"); - (*HACK to prevent getting stuck in parser*) + (* HACK overwriting stdout formatter because fucking ocaml/toplevel/topdirs.ml hardcodes it *) + Format.pp_set_formatter_out_functions Format.std_formatter (out_funs_of_sob t.res); + + let b = Buffer.create 69 in + format_symbolic_output_buffer (Format.formatter_of_buffer b) (Format.flush_symbolic_output_buffer t.res); + ignore (Lwt_main.run (Store.tree t.storeview.s >>= fun tree -> + Store.Tree.add tree (t.histpath @ ["output"]) (Buffer.contents b))); + ignore (Lwt_main.run (Store.set_exn t.storeview.s ~info:(Irmin_unix.info "history") + t.path (str_of_textedit t.te))); + eval ppf (str_of_textedit t.te ^ ";;"); (*HACK to prevent getting stuck in parser*) ignore (Lwt_main.run ( Store.tree t.storeview.s >>= fun tree -> - Store.Tree.add tree t.path (str_of_textedit t.te) )); - ignore - (Lwt_main.run - (Store.set_exn t.storeview.s - ~info:(Irmin_unix.info "executed") - t.path (str_of_textedit t.te))) + Store.Tree.add tree (t.histpath @ ["input"]) (str_of_textedit t.te) )) | _ -> ()); pane_vbox [ @@ -626,4 +629,12 @@ let draw_komm (s : Display.state) = push @@ draw_top top_1 30. { s with box = !state.box }; (!state, (Box2.of_pts (Box2.o s.box) (Box2.max !box), !node)) -let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) draw_komm) () +let () = while true do + Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) draw_komm) () + done + + + +(* Implement the "window management" as just toplevel defined functions that manipulate the window tree *) + +(* also, i'm tired *) diff --git a/topinf.ml b/topinf.ml index 43f643e..6a4f38c 100644 --- a/topinf.ml +++ b/topinf.ml @@ -44,6 +44,8 @@ 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 getvalue name = try String.Map.find name !toplevel_value_bindings with Not_found -> fatal_error (name ^ " unbound at toplevel") @@ -2328,7 +2330,7 @@ end type evalenv = Format.formatter -> string -> unit -let eval lb ppf (text : string) = +let eval_fun lb ppf (text : string) = Topdirs.std_out := ppf; (read_interactive_input := fun buffer _ -> @@ -2408,4 +2410,5 @@ let init ppf = Location.input_phrase_buffer := Some phrase_buffer; Sys.catch_break true; run_hooks After_setup; - eval lb + eval := Some (eval_fun lb); + eval_fun lb diff --git a/topinf.mli b/topinf.mli index 9c62ee1..7508b3d 100644 --- a/topinf.mli +++ b/topinf.mli @@ -3,7 +3,7 @@ (See module Translmod.) *) val getvalue : string -> Obj.t val setvalue : string -> Obj.t -> unit -(* End accessors for table of toplevel value bindings that must be first in the module signature *) +(* End of: accessors for table of toplevel value bindings that must be first in the module signature *) val print_toplevel_value_bindings : Format.formatter -> unit @@ -22,6 +22,10 @@ type directive_fun = type directive_info = { section : string; doc : string } +val add_directive : Misc.filepath -> directive_fun -> directive_info -> unit + val directive_info_table : (string, directive_info) Hashtbl.t val ppf : Format.formatter ref + +val eval : evalenv option ref