open Dom open Dom_html open Js open Firebug open Goog let msgbox s = console##log (s) type input = | Direct of string * (unit -> string) | Url of string let children_of_node node = let c = ref [] in for i = 0 to node##childNodes##length - 1 do let node = Js.Opt.get (node##childNodes##item (i)) (fun _ -> assert false) in match node##nodeType with | Dom.DOCUMENT | Dom.DOCUMENT_FRAGMENT | Dom.ELEMENT | Dom.CDATA_SECTION -> c := node :: !c | _ -> () done; List.rev !c let contents_of_node (node : node Js.t) = let c = ref [] in match node##nodeType with | Dom.CDATA_SECTION -> let t = Js.Opt.get (Dom.CoerceTo.text (node :> node Js.t)) (fun _ -> assert false) in t##data | _ -> for i = 0 to node##childNodes##length - 1 do let node = Js.Opt.get (node##childNodes##item (i)) (fun _ -> assert false) in match node##nodeType with | Dom.TEXT | Dom.CDATA_SECTION -> c := node :: !c | _ -> () done; Js.Opt.get ((List.hd !c)##nodeValue) (fun _ -> Js.string "Error") let (>>=) = Lwt.bind let http_get url = XmlHttpRequest.get url >>= fun r -> let cod = r.XmlHttpRequest.code in let msg = r.XmlHttpRequest.content_xml () in if cod = 0 || cod = 200 then Lwt.return msg else fst (Lwt.wait ()) let load_input_from_url url = let extract_inputs frame = match frame with | None -> Dom_html.window##alert (Js.string "Loading of examples failed."); [] | Some inputs_doc -> let inputs_root = List.hd (children_of_node inputs_doc) in let inputs_nodes = children_of_node inputs_root in let inputs = List.map (fun n -> msgbox n; let data = children_of_node n in msgbox data; let get i = Js.to_string (contents_of_node (List.nth data i)) in (get 0, fun () -> get 1)) inputs_nodes in inputs in Lwt.catch (fun () -> http_get url >>= (fun frame -> Lwt.return (extract_inputs frame))) (function _ -> Lwt.return [] ) type output = (string * string) let impossible _ = assert false let ccs s = Goog.Ui.ControlContent.string (Js.string s) let add_item s (m : Goog.Ui.menu Js.t) = m##addItem (Goog.Tools.Union.i1 jsnew Goog.Ui.menuItem (ccs s, Js.null, Js.null)) let get_element s = Js.Opt.get (Dom_html.document##getElementById (s)) (fun _ -> Dom_html.window##alert (s); assert false) let new_tab tabbar label = let tab = jsnew Ui.tab (Ui.ControlContent.string label, Js.null, Js.null) in Ui.Component.addChild tabbar tab (Js.some Js._true); tab let new_button toolbar label onclick = let button = jsnew Ui.toolbarButton (Ui.ControlContent.string (Js.string label), Js.null, Js.null) in Ui.Component.addChild toolbar button (Js.some Js._true); ignore (Events.listen (Tools.Union.i1 button) (Js.string "action") (Js.wrap_callback (fun _ -> onclick ())) Js.null) let new_menu toolbar label entries onchange = let menu = jsnew Goog.Ui.menu (Js.null, Js.null) in List.iter (fun s -> add_item s menu) entries; let menu_button = jsnew Ui.toolbarMenuButton (Ui.ControlContent.string (Js.string label), Js.some menu, Js.null, Js.null) in ignore (Events.listen (Tools.Union.i1 menu_button) (Js.string "action") (Js.wrap_callback (fun e -> let get x : Goog.Ui.menuItem Js.t = Js.Unsafe.coerce (Js.Optdef.get x (fun _ -> assert false)) in onchange ((get (e##target))##getCaption ()))) Js.null); Ui.Component.addChild toolbar menu_button (Js.some Js._true); menu type input_interface = { get_input : unit -> Js.js_string Js.t * Js.js_string Js.t; new_output_tabs : (Js.js_string Js.t * Js.js_string Js.t) list -> unit; clear_output_tabs : unit -> unit; close : unit -> unit } let input_interfaces : (Js.js_string Js.t, input_interface) Hashtbl.t = Hashtbl.create 13 let fresh_name n = let rec aux i = let name = if i = 0 then n else (n##concat (Js.string (string_of_int i))) in if Hashtbl.mem input_interfaces name then aux (i + 1) else name in aux 0 let new_input (tabbar : Ui.tabBar Js.t) choice (contents : Js.js_string Js.t) = let choice = fresh_name choice in let tab_contents = get_element ((Js.string "maintabbar_content")) in let source_label = choice##concat (Js.string "_source") in let content_label = choice##concat (Js.string "_contents") in let tab = new_tab tabbar choice in let tab_frame = Dom_html.createDiv (Dom_html.document) in let subtab_frame = Dom_html.createDiv (Dom_html.document) in let contents_tab_frame = Dom_html.createDiv (Dom_html.document) in let clear_tab_frame = Dom_html.createDiv (Dom_html.document) in let subtabs = jsnew Ui.tabBar ( Js.some (Ui.TabBar.location_pre_of_location Ui.TabBar.BOTTOM), Js.null, Js.null) in contents_tab_frame##className <- Js.string "goog-tab-content"; contents_tab_frame##id <- content_label; subtab_frame##className <- Js.string "goog-tab-bar goog-tab-bar-start"; clear_tab_frame##className <- Js.string "goog-tab-bar-clear"; subtabs##decorate ((subtab_frame :> Dom_html.element Js.t)); ignore (tab_frame##appendChild ((subtab_frame :> Dom.node Js.t))); ignore (tab_frame##appendChild ((contents_tab_frame :> Dom.node Js.t))); ignore (tab_frame##appendChild ((clear_tab_frame :> Dom.node Js.t))); (* Source code editor. *) let text = Dom_html.createTextarea (Dom_html.document) in text##className <- Js.string "editor"; text##value <- contents; let change_tab_content node = if contents_tab_frame##hasChildNodes () = _true then ignore (contents_tab_frame##removeChild (Js.Opt.get contents_tab_frame##firstChild impossible)); ignore (contents_tab_frame##appendChild (node)) in let input_tab = new_tab subtabs source_label in ignore (Events.listen (Tools.Union.i1 input_tab) (Js.string "select") (Js.wrap_callback (fun e -> change_tab_content ((text :> Dom.node Js.t)))) Js.null); ignore (Events.listen (Tools.Union.i1 tab) (Js.string "select") (Js.wrap_callback (fun e -> if tab_contents##hasChildNodes () = _true then ignore (tab_contents##removeChild (Js.Opt.get tab_contents##firstChild impossible)); ignore (tab_contents##appendChild ((tab_frame :> Dom.node Js.t))))) Js.null); tabbar##setSelectedTab (Js.some tab); subtabs##setSelectedTab (Js.some input_tab); let get_input () = (choice, text##value) in let output_tabs = ref [] in let new_output_tabs outputs = let new_output_tab (title, value) = let output_tab = new_tab subtabs (choice##concat (title)) in let output_frame = Dom_html.createDiv (Dom_html.document) in output_tabs := output_tab :: !output_tabs; let text = Dom_html.createTextarea (Dom_html.document) in text##className <- Js.string "editor"; text##value <- value; ignore (output_frame##appendChild ((text :> Dom.node Js.t))); ignore (Events.listen (Tools.Union.i1 output_tab) (Js.string "select") (Js.wrap_callback (fun e -> change_tab_content ((output_frame :> Dom.node Js.t)))) Js.null) in List.iter new_output_tab outputs in let clear_output_tabs () = List.iter (fun tab -> ignore (subtabs##removeChild (Goog.Tools.Union.i2 tab, Js.some Js._true))) !output_tabs; output_tabs := [] in let close () = Hashtbl.remove input_interfaces choice; ignore (contents_tab_frame##removeChild ((text :> Dom.node Js.t))); subtabs##disposeInternal (); ignore (tabbar##removeChild (Goog.Tools.Union.i2 tab, Js.some Js._true)) in Hashtbl.add input_interfaces choice { get_input = get_input; new_output_tabs = new_output_tabs; clear_output_tabs = clear_output_tabs; close = close; } let help_message = "
Please be aware of the limited computational power of JavaScript. Your O'Caml program will run 10 times slower than a natively compiled one.
Create from...
to load
a predefined input. This should create a tab in the
interface for this specific instance of the input. You
can freely edit this input in the text area.
Run
to process the input. This should create
a set of tabs to store the outputs. You can use
Run
several times: the outputs will be refreshed
if the input has changed.
Close
to dispose the input instance corresponding
to the selected tab. Be aware that you will lost your local modifications.
Help
to open this dialog box.