X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftree.ml;h=434d19598bfe2430e7b06343168f4d770ee7d113;hb=5e7268fb95cdc7e56fe24f324a710550ade3d851;hp=c30427ca0403976318efb99d4c3dff38f37b607f;hpb=cba2938d929fd5119b1491686ddc224d5af618c6;p=tatoo.git diff --git a/src/tree.ml b/src/tree.ml index c30427c..434d195 100644 --- a/src/tree.ml +++ b/src/tree.ml @@ -99,7 +99,12 @@ struct let is_left n = n.next_sibling == dummy - let start_element_handler parser_ ctx tag attr_list = + + 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; let parent = top ctx in let n = { tag = QName.of_string tag; preorder = next ctx; @@ -111,14 +116,28 @@ struct in if parent.first_child == dummy then parent.first_child <- n else parent.next_sibling <- n; - push n ctx - - let rec consume_closing ctx n = + 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 let _ = pop ctx in consume_closing ctx (top ctx) - - let end_element_handler parser_ ctx tag = + and end_element_handler parser_ ctx tag = + do_text parser_ ctx; let node = top ctx in if node.first_child == dummy then node.first_child <- nil else begin @@ -126,8 +145,19 @@ struct consume_closing ctx node end - let character_data_handler parser_ _ t text = - Buffer.add_string t text + and do_text parser_ ctx = + if Buffer.length ctx.text_buffer != 0 then + let s = Buffer.contents ctx.text_buffer in + Buffer.clear ctx.text_buffer; + start_element_handler parser_ ctx text_string []; + let node = top ctx in + node.data <- s; + end_element_handler parser_ ctx text_string + + + + let character_data_handler parser_ ctx text = + Buffer.add_string ctx.text_buffer text let create_parser () = let ctx = { text_buffer = Buffer.create 512; @@ -136,6 +166,7 @@ struct let parser_ = Expat.parser_create ~encoding:None in Expat.set_start_element_handler parser_ (start_element_handler parser_ ctx); Expat.set_end_element_handler parser_ (end_element_handler parser_ ctx); + Expat.set_character_data_handler parser_ (character_data_handler parser_ ctx); push { tag = QName.document; preorder = next ctx; data = ""; @@ -177,28 +208,108 @@ 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 "<" + | '>' -> 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 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 "/>" - else begin - output_char out '>'; - print_xml out tree_ node.first_child; - output_string out "' - end; + let () = + if node.tag == QName.text then + output_escape_string out node.data + else + let tag = QName.to_string node.tag in + output_char out '<'; + output_string out tag; + 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_ fchild; + output_string out "' + end + in print_xml out tree_ node.next_sibling - 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 "' + end + in + print_xml_preorder out tree_ node.next_sibling + +let debug_node fmt t n = + Parser.debug_node fmt n