let text_string = QName.to_string QName.text
+ let attr_map_string = QName.to_string QName.attribute_map
let rec start_element_handler parser_ ctx tag attr_list =
do_text parser_ ctx;
in
if parent.first_child == dummy then parent.first_child <- n
else parent.next_sibling <- n;
- push n ctx
+ push n ctx;
+ match attr_list with
+ [] -> ()
+ | _ ->
+ start_element_handler parser_ ctx attr_map_string [];
+ List.iter (do_attribute parser_ ctx) attr_list;
+ end_element_handler parser_ ctx attr_map_string
+
+ and do_attribute parser_ ctx (att, value) =
+ let att_tag = " " ^ att in
+ start_element_handler parser_ ctx att_tag [];
+ start_element_handler parser_ ctx text_string [];
+ let n = top ctx in n.data <- value;
+ end_element_handler parser_ ctx text_string;
+ end_element_handler parser_ ctx att_tag
and consume_closing ctx n =
if n.next_sibling != dummy then
and end_element_handler parser_ ctx tag =
do_text parser_ ctx;
let node = top ctx in
- if nodef.first_child == dummy then node.first_child <- nil
+ if node.first_child == dummy then node.first_child <- nil
else begin
node.next_sibling <- nil;
consume_closing ctx node
start_element_handler parser_ ctx text_string [];
let node = top ctx in
node.data <- s;
- end_element_handler parser_ ctx text_string;
- Format.eprintf "DEBUG: %a\n\n" debug_ctx ctx
+ end_element_handler parser_ ctx text_string
+
let character_data_handler parser_ ctx text =
let load_xml_file = Parser.parse_file
let load_xml_string = Parser.parse_string
+
+let output_escape_string out s =
+ for i = 0 to String.length s - 1 do
+ match s.[i] with
+ | '<' -> output_string out "<"
+ | '>' -> output_string out ">"
+ | '&' -> output_string out "&"
+ | '"' -> output_string out """
+ | '\'' -> output_string out "'"
+ | c -> output_char out c
+ done
+
+let rec print_attributes out tree_ node =
+ if node != nil then begin
+ output_string out (QName.to_string node.tag);
+ output_string out "=\"";
+ output_escape_string out node.first_child.data;
+ output_char out '"';
+ print_attributes out tree_ node.next_sibling
+ end
+
let rec print_xml out tree_ node =
if node != nil then
let () =
if node.tag == QName.text then
- output_string out node.data
+ output_escape_string out node.data
else
let tag = QName.to_string node.tag in
output_char out '<';
output_string out tag;
- (* print attributes *)
- if node.first_child == nil then output_string out "/>"
+ let fchild =
+ if node.first_child.tag == QName.attribute_map then
+ let () =
+ print_attributes out tree_ node.first_child.first_child
+ in
+ node.first_child.next_sibling
+ else
+ node.first_child
+ in
+ if fchild == nil then output_string out "/>"
else begin
output_char out '>';
- print_xml out tree_ node.first_child;
+ print_xml out tree_ fchild;
output_string out "</";
output_string out tag;
output_char out '>'
let root t = t.root
let first_child _ n = n.first_child
+let first_child_x _ n =
+ if n.first_child.tag == QName.attribute_map
+ then n.first_child.next_sibling
+ else n.first_child
let next_sibling _ n = n.next_sibling
let parent _ n = n.parent
+(* Begin Lucca Hirschi *)
+let is_leaf t n = (not (n.tag == QName.attribute_map)) &&
+ (first_child t n == nil) && (next_sibling t n == nil)
+let is_attribute t n = n.tag == QName.attribute_map
+(* End *)
let tag _ n = n.tag
let data _ n = n.data
let preorder _ n = n.preorder
+
+(*Lucca Hirschi: *)
+let rec print_xml_preorder out tree_ node =
+ if node != nil then
+ let () =
+ if node.tag == QName.text then
+ begin
+ output_escape_string out node.data;
+ output_string out ("'"^(string_of_int(preorder tree_ node)));
+ end
+ else
+ let tag = QName.to_string node.tag in
+ output_char out '<';
+ output_string out tag;
+ output_string out (" '"^(string_of_int(preorder tree_ node)));
+ let fchild =
+ if node.first_child.tag == QName.attribute_map then
+ let () =
+ let ffn = node.first_child.first_child in
+ print_attributes out tree_ ffn;
+ in
+ node.first_child.next_sibling
+ else
+ node.first_child
+ in
+ if fchild == nil then output_string out "/>"
+ else begin
+ output_char out '>';
+ print_xml_preorder out tree_ fchild;
+ output_string out "</";
+ output_string out tag;
+ output_char out '>'
+ end
+ in
+ print_xml_preorder out tree_ node.next_sibling
+
+let debug_node fmt t n =
+ Parser.debug_node fmt n