diff --git a/boot.ml b/boot.ml index 6f0deb2..e719b75 100644 --- a/boot.ml +++ b/boot.ml @@ -1,2 +1,2 @@ let eval = (Topinf.init Format.std_formatter) Format.std_formatter in -eval "#use \"init.ml\";;" +eval "#use \"init.ml\";;" diff --git a/init.ml b/init.ml index 2900ce7..df5d6b7 100644 --- a/init.ml +++ b/init.ml @@ -1,7 +1,6 @@ (* $Id$ -*- tuareg -*- *) -Sys.command "dune top | head -n -1 > .topenv";; (* `head -n -1` to remove the topinf.cma which fuck this shit all up *) -#use ".topenv";; +#use_output "dune top | grep -v \"ocamltoplevel.cma\\|ocaml_toplevel.cma\\|topinf.cma\"";; (* `head -n -1` to remove the topinf.cma which fuck this shit all up *) open Topinf;; let print_directives () = Format.printf "directive_info_table:@."; @@ -13,4 +12,5 @@ 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";; +#use_silently "main.ml";; + diff --git a/main.ml b/main.ml index f81cfa9..0291fe8 100644 --- a/main.ml +++ b/main.ml @@ -106,6 +106,8 @@ module Display = struct (the Wall.image extents) *) type pane = state -> state * image + type panebox = pane list -> state -> state * image + type panedom = Empty | Pane of pane | Box of (panebox * panedom list) type frame = { sdl_win : Sdl.window; @@ -204,6 +206,9 @@ module Display = struct done; print_endline "quit"; Sdl.hide_window frame.sdl_win; + Sdl.gl_delete_context frame.gl; + Sdl.destroy_window frame.sdl_win; + Sdl.quit (); () let gray ?(a = 1.0) v = Color.v v v v a @@ -564,8 +569,8 @@ let make_top storepath ?(branch = "current") () = 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 @@ -590,17 +595,19 @@ let draw_top (t : top) height (s : Display.state) = (* 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))); + Store.Tree.add tree (t.histpath @ ["input"]) (str_of_textedit t.te) )); + + ignore (Format.flush_symbolic_output_buffer t.res); + eval ppf (str_of_textedit t.te ^ ";;"); (*HACK to prevent getting stuck in parser*) + + let b = Buffer.create 69 in + format_symbolic_output_buffer (Format.formatter_of_buffer b) (Format.get_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.histpath @ ["input"]) (str_of_textedit t.te) )) + Zed_edit.clear_data t.te.ze; | _ -> ()); pane_vbox [ @@ -617,24 +624,21 @@ let draw_top (t : top) height (s : Display.state) = let top_1 = make_top "../rootstore" () -let draw_komm (s : Display.state) = +let draw_komm_default (s : Display.state) = let node, state, box = (ref I.empty, ref s, ref s.box) in let push (s, (b, i)) = node := I.stack !node i; state := s; box := b in - push @@ fill_box (Display.gray 0.125) s.box !state; - (* gray bg *) + push @@ fill_box (Display.gray 0.125) s.box !state; (* gray bg *) push @@ draw_top top_1 30. { s with box = !state.box }; (!state, (Box2.of_pts (Box2.o s.box) (Box2.max !box), !node)) -let () = while true do - Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) draw_komm) () - done - - +let draw_komm = ref draw_komm_default + +let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) !draw_komm) () (* 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 6a4f38c..8241190 100644 --- a/topinf.ml +++ b/topinf.ml @@ -1717,6 +1717,8 @@ module Topdirs = struct let dir_mod_use ppf name = ignore (mod_use_file ppf name) + let dir_use_silently ppf name = ignore (use_silently ppf name) + let _ = add_directive "use" (Directive_string (dir_use !std_out)) @@ -1745,6 +1747,15 @@ module Topdirs = struct module."; } + let _ = + add_directive "use_silently" + (Directive_string (dir_use_silently !std_out)) + { + section = section_run; + doc = + "Usage is identical to #use but #use_silently supresses all toplevel definition output."; + } + (* Install, remove a printer *) let filter_arrow ty =