(*********************************************************************************) |
(* Cameleon *)
(* *)
(* Copyright (C) 2005,2006 Institut National de Recherche en Informatique *)
(* et en Automatique. All rights reserved. *)
(* *)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU Library General Public License as *)
(* published by the Free Software Foundation; either version 2 of the *)
(* License, or any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Library General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Library General Public *)
(* License along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *)
(* 02111-1307 USA *)
(* *)
(* Contact: Maxence.Guesdon@inria.fr *)
(* *)
(*********************************************************************************) |
(** Functions to build and compute a report. *) |
open Rep_types
(** Coerce report elements. *) |
let coerce = Obj.magic
(** This function takes a tag and returns true if it must be closed. *) |
let must_close html tag =
match String.lowercase tag with
"br" | "area" | "base"| "basefont" | "col" | "frame"
| "hr" | "img" | "input" | "isindex" | "link" | "meta" | "param" ->
not html
| _ ->
true
(** Compute and print a report element to a given formatter. *) |
let rec print html fmt rep_ele =
match rep_ele with
Leaf f ->
Format.pp_print_string fmt (f ())
| Tag t ->
let s =
"<"^t.tag^
(List.fold_left
(fun acc -> fun (att,f) -> acc^" "^att^"=\""^(f ())^"\"")
""
t.atts)^
">"
in
Format.pp_print_string fmt s;
List.iter (print html fmt) t.tag_subs ;
if must_close html t.tag then
Format.pp_print_string fmt ("</"^t.tag^">")
| List list ->
let l = list.f () in
List.iter
(fun ele ->
List.iter (print html fmt) (list.list_subs ele)
)
l
| Cond c ->
List.iter (print html fmt)
(if c.cond () then
c.subs_then
else
c.subs_else)
| Sub s ->
let r = s.sub_rep () in
List.iter (print html fmt) r.rep_eles
(** Print a report into the given formatter. *) |
let print_fmt ?(html=false) fmt report =
List.iter (print html fmt) report.rep_eles;
Format.pp_print_flush fmt ()
(** Compute and print a report to a given file. *) |
let rec print_file ?(html=false) file report =
try
let chanout = open_out file in
let fmt = Format.formatter_of_out_channel chanout in
print_fmt ~html fmt report;
close_out chanout
with
Sys_error s ->
raise (Failure s)