pretty good
This commit is contained in:
6
init.ml
6
init.ml
@ -1,7 +1,6 @@
|
|||||||
(* $Id$ -*- tuareg -*- *)
|
(* $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_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 *)
|
||||||
#use ".topenv";;
|
|
||||||
open Topinf;;
|
open Topinf;;
|
||||||
let print_directives () =
|
let print_directives () =
|
||||||
Format.printf "directive_info_table:@.";
|
Format.printf "directive_info_table:@.";
|
||||||
@ -13,4 +12,5 @@ let print_modules () =
|
|||||||
Format.printf "Env.fold_modules !Topinf.toplevel_env :\n";
|
Format.printf "Env.fold_modules !Topinf.toplevel_env :\n";
|
||||||
Env.fold_modules (fun modname _ _ () -> Format.printf "\t%s@." modname) None !Topinf.toplevel_env ();;
|
Env.fold_modules (fun modname _ _ () -> Format.printf "\t%s@." modname) None !Topinf.toplevel_env ();;
|
||||||
|
|
||||||
#use "main.ml";;
|
#use_silently "main.ml";;
|
||||||
|
|
||||||
|
|||||||
36
main.ml
36
main.ml
@ -106,6 +106,8 @@ module Display = struct
|
|||||||
(the Wall.image extents) *)
|
(the Wall.image extents) *)
|
||||||
|
|
||||||
type pane = state -> state * image
|
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 = {
|
type frame = {
|
||||||
sdl_win : Sdl.window;
|
sdl_win : Sdl.window;
|
||||||
@ -204,6 +206,9 @@ module Display = struct
|
|||||||
done;
|
done;
|
||||||
print_endline "quit";
|
print_endline "quit";
|
||||||
Sdl.hide_window frame.sdl_win;
|
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
|
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 ();
|
storeview = make_storeview storepath branch ();
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
(* Topinf.ppf := Format.formatter_of_symbolic_output_buffer 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);*)
|
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
|
let zctx = Zed_edit.context t.te.ze t.te.zc in
|
||||||
Zed_edit.insert zctx
|
Zed_edit.insert zctx
|
||||||
(Zed_rope.of_string
|
(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 *)
|
(* 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);
|
Format.pp_set_formatter_out_functions Format.std_formatter (out_funs_of_sob t.res);
|
||||||
|
|
||||||
|
ignore (Lwt_main.run (Store.tree t.storeview.s >>= fun tree ->
|
||||||
|
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
|
let b = Buffer.create 69 in
|
||||||
format_symbolic_output_buffer (Format.formatter_of_buffer b) (Format.flush_symbolic_output_buffer t.res);
|
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 ->
|
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 @ ["output"]) (Buffer.contents b)));
|
||||||
ignore (Lwt_main.run (Store.set_exn t.storeview.s ~info:(Irmin_unix.info "history")
|
ignore (Lwt_main.run (Store.set_exn t.storeview.s ~info:(Irmin_unix.info "history")
|
||||||
t.path (str_of_textedit t.te)));
|
t.path (str_of_textedit t.te)));
|
||||||
eval ppf (str_of_textedit t.te ^ ";;"); (*HACK to prevent getting stuck in parser*)
|
Zed_edit.clear_data t.te.ze;
|
||||||
ignore
|
|
||||||
(Lwt_main.run
|
|
||||||
( Store.tree t.storeview.s >>= fun tree ->
|
|
||||||
Store.Tree.add tree (t.histpath @ ["input"]) (str_of_textedit t.te) ))
|
|
||||||
| _ -> ());
|
| _ -> ());
|
||||||
pane_vbox
|
pane_vbox
|
||||||
[
|
[
|
||||||
@ -617,24 +624,21 @@ let draw_top (t : top) height (s : Display.state) =
|
|||||||
|
|
||||||
let top_1 = make_top "../rootstore" ()
|
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 node, state, box = (ref I.empty, ref s, ref s.box) in
|
||||||
let push (s, (b, i)) =
|
let push (s, (b, i)) =
|
||||||
node := I.stack !node i;
|
node := I.stack !node i;
|
||||||
state := s;
|
state := s;
|
||||||
box := b
|
box := b
|
||||||
in
|
in
|
||||||
push @@ fill_box (Display.gray 0.125) s.box !state;
|
push @@ fill_box (Display.gray 0.125) s.box !state; (* gray bg *)
|
||||||
(* gray bg *)
|
|
||||||
push @@ draw_top top_1 30. { s with box = !state.box };
|
push @@ draw_top top_1 30. { s with box = !state.box };
|
||||||
(!state, (Box2.of_pts (Box2.o s.box) (Box2.max !box), !node))
|
(!state, (Box2.of_pts (Box2.o s.box) (Box2.max !box), !node))
|
||||||
|
|
||||||
let () = while true do
|
let draw_komm = ref draw_komm_default
|
||||||
Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) draw_komm) ()
|
|
||||||
done
|
|
||||||
|
|
||||||
|
|
||||||
|
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 *)
|
(* Implement the "window management" as just toplevel defined functions that manipulate the window tree *)
|
||||||
|
|
||||||
(* also, i'm tired *)
|
|
||||||
|
|||||||
11
topinf.ml
11
topinf.ml
@ -1717,6 +1717,8 @@ module Topdirs = struct
|
|||||||
|
|
||||||
let dir_mod_use ppf name = ignore (mod_use_file ppf name)
|
let dir_mod_use ppf name = ignore (mod_use_file ppf name)
|
||||||
|
|
||||||
|
let dir_use_silently ppf name = ignore (use_silently ppf name)
|
||||||
|
|
||||||
let _ =
|
let _ =
|
||||||
add_directive "use"
|
add_directive "use"
|
||||||
(Directive_string (dir_use !std_out))
|
(Directive_string (dir_use !std_out))
|
||||||
@ -1745,6 +1747,15 @@ module Topdirs = struct
|
|||||||
module.";
|
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 *)
|
(* Install, remove a printer *)
|
||||||
|
|
||||||
let filter_arrow ty =
|
let filter_arrow ty =
|
||||||
|
|||||||
Reference in New Issue
Block a user