helm/gTopLevel/xml2Gdome.ml

   1 let document_of_xml (domImplementation : Gdome.domImplementation) strm =
   2  let module G = Gdome in
   3  let module X = Xml in
   4   let root_name,root_attributes,root_content =
   5    match Stream.next strm with
   6       X.Empty(n,l) -> n,l,[<>]
   7     | X.NEmpty(n,l,c) -> n,l,c
   8     | _ -> assert false
   9   in
  10    let document =
  11     domImplementation#createDocument ~namespaceURI:None
  12      ~qualifiedName:(Gdome.domString root_name) ~doctype:None
  13    in
  14    let rec aux (node : Gdome.node) =
  15     parser
  16       [< 'X.Str a ; s >] ->
  17         let textnode = document#createTextNode ~data:(Gdome.domString a) in
  18          ignore (node#appendChild ~newChild:(textnode :> Gdome.node)) ;
  19          aux node s
  20     | [< 'X.Empty(n,l) ; s >] ->
  21         let element = document#createElement ~tagName:(Gdome.domString n) in
  22          List.iter (function (n,v) -> element#setAttribute
  23           ~name:(Gdome.domString n) ~value:(Gdome.domString v)) l ;
  24          ignore
  25           (node#appendChild ~newChild:(element : Gdome.element :> Gdome.node)) ;
  26          aux node s
  27     | [< 'X.NEmpty(n,l,c) ; s >] ->
  28         let element = document#createElement ~tagName:(Gdome.domString n) in
  29          List.iter
  30           (function (n,v) ->
  31             element#setAttribute ~name:(Gdome.domString n)
  32              ~value:(Gdome.domString v)
  33           ) l ;
  34          ignore (node#appendChild ~newChild:(element :> Gdome.node)) ;
  35          aux (element :> Gdome.node) c ;
  36          aux node s
  37     | [< >] -> ()
  38    in
  39     let root = document#get_documentElement in
  40      List.iter (function (n,v) -> root#setAttribute
  41       ~name:(Gdome.domString n) ~value:(Gdome.domString v)) root_attributes ;
  42      aux (root : Gdome.element :> Gdome.node) root_content ;
  43      document
  44 ;;