some progress

colorize.ml

@@ -0,0 +1,39 @@
+open Js_of_ocaml
+open Js_of_ocaml_tyxml
+
+let text ~a_class:cl s = Tyxml_js.Html.(span ~a:[ a_class [ cl ] ] [ txt s ])
+
+let ocaml ~a_class:cl s =
+  let tks = Higlo.Lang.parse ~lang:"ocaml" s in
+  let span' cl (s, _) = Tyxml_js.Html.(span ~a:[ a_class [ cl ] ] [ txt s ]) in
+  let make_span = function
+    | Higlo.Lang.Bcomment s -> span' "comment" s
+    | Higlo.Lang.Constant s -> span' "constant" s
+    | Higlo.Lang.Directive s -> span' "directive" s
+    | Higlo.Lang.Escape s -> span' "escape" s
+    | Higlo.Lang.Id s -> span' "id" s
+    | Higlo.Lang.Keyword (level, s) -> span' (Printf.sprintf "kw%d" level) s
+    | Higlo.Lang.Lcomment s -> span' "comment" s
+    | Higlo.Lang.Numeric s -> span' "numeric" s
+    | Higlo.Lang.String s -> span' "string" s
+    | Higlo.Lang.Symbol (level, s) -> span' (Printf.sprintf "sym%d" level) s
+    | Higlo.Lang.Text s -> span' "text" s
+    | Higlo.Lang.Title (_, s) -> span' "text" s
+  in
+  Tyxml_js.Html.(div ~a:[ a_class [ cl ] ] (List.map make_span tks))
+
+let highlight (`Pos from_) to_ e =
+  let _ =
+    List.fold_left
+      (fun pos e ->
+        match Js.Opt.to_option (Dom_html.CoerceTo.element e) with
+        | None -> pos
+        | Some e ->
+            let size = Js.Opt.case e##.textContent (fun () -> 0) (fun t -> t##.length) in
+            if pos + size > from_ && (to_ = `Last || `Pos pos < to_)
+            then e##.classList##add (Js.string "errorloc");
+            pos + size)
+      0
+      (Dom.list_of_nodeList e##.childNodes)
+  in
+  ()