diff --git a/init.ml b/init.ml index ef63f85..b9235f6 100644 --- a/init.ml +++ b/init.ml @@ -3,13 +3,12 @@ #directory "/home/cqc/p/console/boot/_build/default/.topinf.objs/byte";; open Topinf;; let print_directives () = - Format.eprintf "directive_info_table:@."; - Hashtbl.iter (fun n _ -> Format.eprintf "\t%s@." n) Topinf.directive_info_table;; + Format.printf "directive_info_table:@."; + Hashtbl.iter (fun n _ -> Format.printf "\t%s@." n) Topinf.directive_info_table;; #directory "+compiler-libs";; let print_modules () = - Format.eprintf "Env.fold_modules:\n"; - Env.fold_modules (fun modname _ _ () -> Format.eprintf "\t%s@." modname) None !Topinf.toplevel_env ();; -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 ();; diff --git a/main.ml b/main.ml index f6e3376..0068513 100644 --- a/main.ml +++ b/main.ml @@ -529,22 +529,6 @@ type top = { storeview : storeview; } -let make_top storepath ?(branch = "current") () = - let t = - { - te = make_textedit (); - res = Format.make_symbolic_output_buffer (); - eval = None; - path = [ "init" ]; - storeview = make_storeview storepath branch (); - } - in - let zctx = Zed_edit.context t.te.ze t.te.zc in - Zed_edit.insert zctx - (Zed_rope.of_string - (Zed_string.of_utf8 (Lwt_main.run (Store.get t.storeview.s t.path)))); - t - let format_symbolic_output_buffer (ppf : Format.formatter) buf = List.iter Format.( @@ -568,28 +552,42 @@ let out_funs_of_sob sob = out_spaces = (fun n -> add_symbolic_output_item sob (Output_spaces n)); } +let make_top storepath ?(branch = "current") () = + let t = + { + te = make_textedit (); + res = Format.make_symbolic_output_buffer (); + eval = None; + path = [ "init" ]; + 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); + let zctx = Zed_edit.context t.te.ze t.te.zc in + Zed_edit.insert zctx + (Zed_rope.of_string + (Zed_string.of_utf8 (Lwt_main.run (Store.get t.storeview.s t.path)))); + t + let draw_top (t : top) height (s : Display.state) = + let ppf = Format.formatter_of_symbolic_output_buffer t.res in + Topinf.ppf := ppf; let eval = match t.eval with | None -> - let e = - Topinf.init (Format.formatter_of_symbolic_output_buffer t.res) - in - t.eval <- Some e; - e + let e = Topinf.init ppf in + t.eval <- Some e; + 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 ]; _ } -> - format_symbolic_output_buffer F.stderr - (Format.flush_symbolic_output_buffer t.res); (* 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 - (Format.formatter_of_symbolic_output_buffer t.res) - (str_of_textedit t.te ^ ";;"); + 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*) ignore (Lwt_main.run diff --git a/topinf.ml b/topinf.ml index 284173a..43f643e 100644 --- a/topinf.ml +++ b/topinf.ml @@ -42,6 +42,8 @@ let phrase_buffer = Buffer.create 1024 (* The table of toplevel value bindings and its accessors *) let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty +let ppf = ref Format.std_formatter + let getvalue name = try String.Map.find name !toplevel_value_bindings with Not_found -> fatal_error (name ^ " unbound at toplevel") diff --git a/topinf.mli b/topinf.mli index dccb749..9c62ee1 100644 --- a/topinf.mli +++ b/topinf.mli @@ -23,3 +23,5 @@ type directive_fun = type directive_info = { section : string; doc : string } val directive_info_table : (string, directive_info) Hashtbl.t + +val ppf : Format.formatter ref