output to draw_pp's ppf

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:@.";
+  Format.printf "directive_info_table:@.";
-  Hashtbl.iter (fun n _ -> Format.eprintf "\t%s@." n) Topinf.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";
+  Format.printf "Env.fold_modules !Topinf.toplevel_env :\n";
-  Env.fold_modules (fun modname _ _ () -> Format.eprintf "\t%s@." modname) None !Topinf.toplevel_env ();;
+  Env.fold_modules (fun modname _ _ () -> Format.printf "\t%s@." modname) None !Topinf.toplevel_env ();;
-print_modules ();;
 

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 =
+      let e = Topinf.init ppf in
-          Topinf.init (Format.formatter_of_symbolic_output_buffer t.res)
+      t.eval <- Some e;
-        in
+      e ppf "#use \"init.ml\";;";
-        t.eval <- Some e;
+      e
-        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
+        Format.pp_set_formatter_out_functions Format.std_formatter (out_funs_of_sob t.res);
-          (out_funs_of_sob t.res);
+        eval ppf (str_of_textedit t.te ^ ";;");
-        eval
-          (Format.formatter_of_symbolic_output_buffer t.res)
-          (str_of_textedit t.te ^ ";;");
         (*HACK to prevent getting stuck in parser*)
         ignore
           (Lwt_main.run

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")

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