some progress

oplevel.ml

@@ -0,0 +1,68 @@
+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)