+++ /dev/null
-exception NoOpenNonEmptyElements
-
-type sectionTree =
- Leaf of Xml.token Stream.t
- | Node of string * (string * string) list * sectionTree list ref
-;;
-
-let rec token_stream_of_section_tree_list =
- function
- he::tl ->
- [< token_stream_of_section_tree_list tl; token_stream_of_section_tree he >]
- | [] -> [<>]
-and token_stream_of_section_tree =
- function
- Leaf t -> [< t >]
- | Node (elem_name, attr_list, section_tree) ->
- Xml.xml_nempty elem_name attr_list
- (token_stream_of_section_tree_list !section_tree)
-;;
-
-let section_stack = ref [];;
-let xmloutput = ref (ref []);;
-let filename = ref "";;
-
-let reset_output fname =
- filename := fname ;
- xmloutput := ref [] ;
- section_stack := []
-;;
-
-let output n =
- let xmloutput = !xmloutput in
- xmloutput := (Leaf n) :: !xmloutput
-;;
-
-let open_non_empty_element elem_name attr_list =
- let newxmloutput = ref [] in
- !xmloutput := (Node (elem_name, attr_list, newxmloutput)) :: !(!xmloutput) ;
- section_stack := !xmloutput :: !section_stack ;
- xmloutput := newxmloutput
-;;
-
-let close_non_empty_element () =
- match !section_stack with
- oldxmloutput::oldsection_stack ->
- xmloutput := oldxmloutput ;
- section_stack := oldsection_stack
- | _ -> raise NoOpenNonEmptyElements
-;;
-
-let print_output () =
- Xml.pp (token_stream_of_section_tree_list !(!xmloutput)) (Some !filename)
-;;