X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2Fxml2Gdome.ml;fp=helm%2FgTopLevel%2Fxml2Gdome.ml;h=43a2fc7ddfaa5199b1989143b470ac265962602d;hb=2329c7fd13fb6c88f9f82ccad6b25a67c9ce7acf;hp=0000000000000000000000000000000000000000;hpb=8b31618bf8fcea8cd62f8017adef41092dd6789b;p=helm.git diff --git a/helm/gTopLevel/xml2Gdome.ml b/helm/gTopLevel/xml2Gdome.ml new file mode 100644 index 000000000..43a2fc7dd --- /dev/null +++ b/helm/gTopLevel/xml2Gdome.ml @@ -0,0 +1,47 @@ +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 = +(*CSC: erroraccio bruttissimo in gmetadom!!! *) + new Gdome.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 +;;