let document_of_xml (domImplementation : Gdome.domImplementation) strm = let module G = Gdome in let module X = Xml in let root_name,root_attributes,root_content = match Stream.next strm with X.Empty(n,l) -> n,l,[<>] | X.NEmpty(n,l,c) -> n,l,c | _ -> assert false in let document = domImplementation#createDocument ~namespaceURI:None ~qualifiedName:(Gdome.domString root_name) ~doctype:None in let rec aux (node : Gdome.node) = parser [< 'X.Str a ; s >] -> let textnode = document#createTextNode ~data:(Gdome.domString a) in ignore (node#appendChild ~newChild:(textnode :> Gdome.node)) ; aux node s | [< 'X.Empty(n,l) ; s >] -> let element = document#createElement ~tagName:(Gdome.domString n) in List.iter (function (n,v) -> element#setAttribute ~name:(Gdome.domString n) ~value:(Gdome.domString v)) l ; ignore (node#appendChild ~newChild:(element : Gdome.element :> Gdome.node)) ; aux node s | [< 'X.NEmpty(n,l,c) ; s >] -> let element = document#createElement ~tagName:(Gdome.domString n) in List.iter (function (n,v) -> element#setAttribute ~name:(Gdome.domString n) ~value:(Gdome.domString v) ) l ; ignore (node#appendChild ~newChild:(element :> Gdome.node)) ; aux (element :> Gdome.node) c ; aux node s | [< >] -> () in let root = document#get_documentElement in List.iter (function (n,v) -> root#setAttribute ~name:(Gdome.domString n) ~value:(Gdome.domString v)) root_attributes ; aux (root : Gdome.element :> Gdome.node) root_content ; document ;;