X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftree.ml;h=434d19598bfe2430e7b06343168f4d770ee7d113;hb=5e7268fb95cdc7e56fe24f324a710550ade3d851;hp=f914d332a9badf518eac73496d74f22574b0072f;hpb=7e9bcacfcf765bf20e19f6277da8471bcf395d26;p=tatoo.git

diff --git a/src/tree.ml b/src/tree.ml
index f914d33..434d195 100644
--- a/src/tree.ml
+++ b/src/tree.ml
@@ -101,6 +101,7 @@ struct
 
 
   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;
@@ -115,7 +116,21 @@ struct
     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
@@ -124,7 +139,7 @@ struct
   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
@@ -137,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 =
@@ -193,20 +208,49 @@ end
 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 "&lt;"
+    | '>' -> output_string out "&gt;"
+    | '&' -> output_string out "&amp;"
+    | '"' -> output_string out "&quot;"
+    | '\'' -> output_string out "&apos;"
+    | 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 '>'
@@ -217,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