diff options
Diffstat (limited to 'lib/xml_utils.ml')
| -rw-r--r-- | lib/xml_utils.ml | 141 |
1 files changed, 0 insertions, 141 deletions
diff --git a/lib/xml_utils.ml b/lib/xml_utils.ml index 60efab577..53e694c7a 100644 --- a/lib/xml_utils.ml +++ b/lib/xml_utils.ml @@ -68,144 +68,3 @@ let fold f v = function | Element (_,_,clist) -> List.fold_left f v clist | x -> raise (Not_element x) -let tmp = Buffer.create 200 - -let buffer_pcdata text = - let l = String.length text in - for p = 0 to l-1 do - match text.[p] with - | '>' -> Buffer.add_string tmp ">" - | '<' -> Buffer.add_string tmp "<" - | '&' -> - if p < l-1 && text.[p+1] = '#' then - Buffer.add_char tmp '&' - else - Buffer.add_string tmp "&" - | '\'' -> Buffer.add_string tmp "'" - | '"' -> Buffer.add_string tmp """ - | c -> Buffer.add_char tmp c - done - -let print_pcdata chan text = - let l = String.length text in - for p = 0 to l-1 do - match text.[p] with - | '>' -> Printf.fprintf chan ">" - | '<' -> Printf.fprintf chan "<" - | '&' -> - if p < l-1 && text.[p+1] = '#' then - Printf.fprintf chan "&" - else - Printf.fprintf chan "&" - | '\'' -> Printf.fprintf chan "'" - | '"' -> Printf.fprintf chan """ - | c -> Printf.fprintf chan "%c" c - done - -let buffer_attr (n,v) = - Buffer.add_char tmp ' '; - Buffer.add_string tmp n; - Buffer.add_string tmp "=\""; - let l = String.length v in - for p = 0 to l-1 do - match v.[p] with - | '\\' -> Buffer.add_string tmp "\\\\" - | '"' -> Buffer.add_string tmp "\\\"" - | c -> Buffer.add_char tmp c - done; - Buffer.add_char tmp '"' - -let print_attr chan (n, v) = - Printf.fprintf chan " %s=\"" n; - let l = String.length v in - for p = 0 to l-1 do - match v.[p] with - | '\\' -> Printf.fprintf chan "\\\\" - | '"' -> Printf.fprintf chan "\\\"" - | c -> Printf.fprintf chan "%c" c - done; - Printf.fprintf chan "\"" - -let print_attrs chan l = List.iter (print_attr chan) l - -let rec print_xml chan = function -| Element (tag, alist, []) -> - Printf.fprintf chan "<%s%a/>" tag print_attrs alist; -| Element (tag, alist, l) -> - Printf.fprintf chan "<%s%a>%a</%s>" tag print_attrs alist - (fun chan -> List.iter (print_xml chan)) l tag -| PCData text -> - print_pcdata chan text - -let to_string x = - let pcdata = ref false in - let rec loop = function - | Element (tag,alist,[]) -> - Buffer.add_char tmp '<'; - Buffer.add_string tmp tag; - List.iter buffer_attr alist; - Buffer.add_string tmp "/>"; - pcdata := false; - | Element (tag,alist,l) -> - Buffer.add_char tmp '<'; - Buffer.add_string tmp tag; - List.iter buffer_attr alist; - Buffer.add_char tmp '>'; - pcdata := false; - List.iter loop l; - Buffer.add_string tmp "</"; - Buffer.add_string tmp tag; - Buffer.add_char tmp '>'; - pcdata := false; - | PCData text -> - if !pcdata then Buffer.add_char tmp ' '; - buffer_pcdata text; - pcdata := true; - in - Buffer.reset tmp; - loop x; - let s = Buffer.contents tmp in - Buffer.reset tmp; - s - -let to_string_fmt x = - let rec loop ?(newl=false) tab = function - | Element (tag,alist,[]) -> - Buffer.add_string tmp tab; - Buffer.add_char tmp '<'; - Buffer.add_string tmp tag; - List.iter buffer_attr alist; - Buffer.add_string tmp "/>"; - if newl then Buffer.add_char tmp '\n'; - | Element (tag,alist,[PCData text]) -> - Buffer.add_string tmp tab; - Buffer.add_char tmp '<'; - Buffer.add_string tmp tag; - List.iter buffer_attr alist; - Buffer.add_string tmp ">"; - buffer_pcdata text; - Buffer.add_string tmp "</"; - Buffer.add_string tmp tag; - Buffer.add_char tmp '>'; - if newl then Buffer.add_char tmp '\n'; - | Element (tag,alist,l) -> - Buffer.add_string tmp tab; - Buffer.add_char tmp '<'; - Buffer.add_string tmp tag; - List.iter buffer_attr alist; - Buffer.add_string tmp ">\n"; - List.iter (loop ~newl:true (tab^" ")) l; - Buffer.add_string tmp tab; - Buffer.add_string tmp "</"; - Buffer.add_string tmp tag; - Buffer.add_char tmp '>'; - if newl then Buffer.add_char tmp '\n'; - | PCData text -> - buffer_pcdata text; - if newl then Buffer.add_char tmp '\n'; - in - Buffer.reset tmp; - loop "" x; - let s = Buffer.contents tmp in - Buffer.reset tmp; - s |