122 lines
4.8 KiB
OCaml
122 lines
4.8 KiB
OCaml
open Js_of_ocaml
|
|
open Js_of_ocaml_tyxml
|
|
open Lwt
|
|
open Store
|
|
|
|
let by_id s = Dom_html.getElementById s
|
|
|
|
let by_id_coerce s f =
|
|
Js.Opt.get
|
|
(f (Dom_html.getElementById s))
|
|
(fun () -> raise Not_found)
|
|
|
|
let resize ~container ~textbox () =
|
|
Lwt.pause () >>= fun () ->
|
|
textbox##.style##.height := Js.string "auto";
|
|
textbox##.style##.height
|
|
:= Js.string (Printf.sprintf "%dpx" (max 18 textbox##.scrollHeight));
|
|
container##.scrollTop := container##.scrollHeight;
|
|
Lwt.return ()
|
|
|
|
let _ =
|
|
Dom_html.window##.onload
|
|
:= Dom_html.handler (fun _ ->
|
|
Lwt.async (fun () ->
|
|
let output = by_id "output" in
|
|
let container = by_id "toplevel-container" in
|
|
|
|
let textbox : 'a Js.t =
|
|
by_id_coerce "userinput" Dom_html.CoerceTo.textarea
|
|
in
|
|
let rootrepo = Store.test_pull () in
|
|
rootrepo >>= fun (upstream, t) ->
|
|
Store.S.tree t >>= fun rootstore ->
|
|
(try
|
|
Store.S.Tree.get rootstore [ ".config"; "init.ml" ]
|
|
with
|
|
| Not_found | Invalid_argument _ ->
|
|
Lwt.return
|
|
"print_newline \"rootstore://.config/init.ml not \
|
|
found\";;"
|
|
| exc ->
|
|
Firebug.console##log_3
|
|
(Js.string ".config/init.ml load exception")
|
|
(Js.string (Printexc.to_string exc))
|
|
exc;
|
|
Lwt.return ";;")
|
|
>>= fun init ->
|
|
let execute = ref (Toplevel.run ~init ~output ()) in
|
|
let meta e =
|
|
let b = Js.to_bool in
|
|
b e##.ctrlKey || b e##.altKey || b e##.metaKey
|
|
in
|
|
let shift e = Js.to_bool e##.shiftKey in
|
|
(* setup handlers *)
|
|
textbox##.onkeyup :=
|
|
Dom_html.handler (fun _ ->
|
|
Lwt.async (resize ~container ~textbox);
|
|
Js._true);
|
|
textbox##.onchange :=
|
|
Dom_html.handler (fun _ ->
|
|
Lwt.async (resize ~container ~textbox);
|
|
Js._true);
|
|
textbox##.onkeydown :=
|
|
Dom_html.handler
|
|
Dom_html.Keyboard_code.(
|
|
fun e ->
|
|
match of_key_code e##.keyCode with
|
|
| Enter when not (meta e || shift e) ->
|
|
Lwt.async (fun () ->
|
|
!execute
|
|
(Js.to_string textbox##.value##trim)
|
|
());
|
|
Js._false
|
|
| Enter ->
|
|
Lwt.async (resize ~container ~textbox);
|
|
Js._true
|
|
| Tab ->
|
|
Indent.textarea textbox;
|
|
Js._false
|
|
| KeyL when meta e ->
|
|
output##.innerHTML := Js.string "";
|
|
Js._true
|
|
| KeyK when meta e ->
|
|
Lwt.async
|
|
Store.S.(
|
|
fun () ->
|
|
rootrepo >>= fun (upstream, t) ->
|
|
Sync.pull_exn t upstream `Set
|
|
>>= fun _ ->
|
|
Firebug.console##log
|
|
(Js.string "Nav.test_pull(6)\n");
|
|
tree t >>= fun rs ->
|
|
(try
|
|
Store.S.Tree.get rs
|
|
[ ".config"; "init.ml" ]
|
|
with
|
|
| Not_found | Invalid_argument _ ->
|
|
Lwt.return
|
|
"print_newline \
|
|
\"rootstore://.config/init.ml \
|
|
not found\";;"
|
|
| exc ->
|
|
Firebug.console##log_3
|
|
(Js.string
|
|
".config/init.ml load \
|
|
exception")
|
|
(Js.string
|
|
(Printexc.to_string exc))
|
|
exc;
|
|
Lwt.return ";;")
|
|
>>= fun init ->
|
|
Lwt.return
|
|
(execute :=
|
|
Toplevel.run ~init ~output ()));
|
|
Js._false
|
|
(* | ArrowUp -> history_up e
|
|
| ArrowDown -> history_down e *)
|
|
| _ -> Js._true);
|
|
Lwt.return_unit);
|
|
|
|
Js._false)
|