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 (*CSC: erroraccio bruttissimo in gmetadom!!! *)
  12     new Gdome.document (
  13     domImplementation#createDocument ~namespaceURI:None
  14      ~qualifiedName:(Gdome.domString root_name) ~doctype:None
  15     )
  16    in
  17    let rec aux (node : Gdome.node) =
  18     parser
  19       [< 'X.Str a ; s >] ->
  20         let textnode = document#createTextNode ~data:(Gdome.domString a) in
  21          ignore (node#appendChild ~newChild:(textnode :> Gdome.node)) ;
  22          aux node s
  23     | [< 'X.Empty(n,l) ; s >] ->
  24         let element = document#createElement ~tagName:(Gdome.domString n) in
  25          List.iter (function (n,v) -> element#setAttribute
  26           ~name:(Gdome.domString n) ~value:(Gdome.domString v)) l ;
  27          ignore
  28           (node#appendChild ~newChild:(element : Gdome.element :> Gdome.node)) ;
  29          aux node s
  30     | [< 'X.NEmpty(n,l,c) ; s >] ->
  31         let element = document#createElement ~tagName:(Gdome.domString n) in
  32          List.iter
  33           (function (n,v) ->
  34             element#setAttribute ~name:(Gdome.domString n)
  35              ~value:(Gdome.domString v)
  36           ) l ;
  37          ignore (node#appendChild ~newChild:(element :> Gdome.node)) ;
  38          aux (element :> Gdome.node) c ;
  39          aux node s
  40     | [< >] -> ()
  41    in
  42     let root = document#get_documentElement in
  43      List.iter (function (n,v) -> root#setAttribute
  44       ~name:(Gdome.domString n) ~value:(Gdome.domString v)) root_attributes ;
  45      aux (root : Gdome.element :> Gdome.node) root_content ;
  46      document
  47 ;;