Merge branch 'lucca-tests-bench' into lucca-extentions

[tatoo.git] / src / tree.ml

diff --git a/src/tree.ml b/src/tree.ml
index 4d01403..434d195 100644 (file)
--- a/src/tree.ml
+++ b/src/tree.ml
@@ -152,8 +152,8 @@ struct
       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 =
@@ -261,8 +261,55 @@ let rec print_xml out tree_ node =
 
 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