69 lines
2.0 KiB
OCaml
69 lines
2.0 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 do_by_id s f =
|
|
try f (Dom_html.getElementById s) with 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 setup_storeview ~container ~textbox ~(storeview : Store.t Lwt.t) :
|
|
unit =
|
|
let storeview_container = by_id "toplevel-storeview" in
|
|
Lwt.async (fun _ ->
|
|
storeview >>= fun storeview ->
|
|
Firebug.console##log "setup_storeview";
|
|
|
|
Store.S.Tree.list storeview [] >>= fun all ->
|
|
ignore
|
|
(List.fold_left
|
|
(fun acc tok ->
|
|
match tok with
|
|
| step, _tree ->
|
|
let a =
|
|
Tyxml_js.Html.(
|
|
a
|
|
~a:
|
|
[
|
|
a_class [ "list-group-item" ];
|
|
a_onclick (fun _ ->
|
|
textbox##.value :=
|
|
(Js.string acc)##trim;
|
|
Lwt.async (fun () ->
|
|
resize ~container ~textbox ()
|
|
>>= fun () ->
|
|
textbox##focus;
|
|
Lwt.return_unit);
|
|
true);
|
|
]
|
|
[ txt step ])
|
|
in
|
|
Dom.appendChild storeview_container
|
|
(Tyxml_js.To_dom.of_a a);
|
|
"")
|
|
"" all);
|
|
Lwt.return_unit)
|
|
|
|
let _ =
|
|
Dom_html.window##.onload
|
|
:= Dom_html.handler (fun _ ->
|
|
Toplevel.run
|
|
(setup_storeview ~storeview:(Store.test_pull ()))
|
|
();
|
|
|
|
Js._false)
|