1 let html_header = format_of_string
3 PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
4 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
5 <html xmlns=\"http://www.w3.org/1999/xhtml\" >
8 <meta http-equiv=\"content-type\" content=\"text/html;
10 <style type=\"text/css\" media=\"all\">
17 div[class=\"touched\"] {
19 text-decoration: none;
22 div[class=\"touched_text\"] {
24 background-color: #00a;
30 div[class=\"selected\"] {
35 div[class=\"selected_text\"] {
37 background-color: #00f;
41 div[class=\"skipped_text\"] {
48 div[class=\"skipped\"] {
53 div:hover[class=\"skipped\"] {
62 div[id=\"tooltipzone\"] span {
64 text-decoration: none;
65 font-family: monospace;
80 div[class=\"header\"]{
87 background-color: white;
90 font-family: monospace;
95 div[class=\"document\"] {
102 font-family: monospace;
107 div[class=\"yellow\"] {
123 <script type=\"text/javascript\">
124 function ShowPopup(span)
126 ttz = document.getElementById('tooltipzone');
127 children = ttz.childNodes;
128 if (children.length == 1){
130 newid = \"div\" + id.substring(2);
131 div = document.getElementById(newid);
132 div.appendChild(children[0]);
134 ttz.appendChild(span);
140 let html_footer = "</div> <!-- document -->
143 let h_trace = Hashtbl.create 4096
144 let register_trace t x = Hashtbl.add h_trace (Tree.id t) x
147 let output_trace a t file results =
148 let h_auto = 6+ (Hashtbl.fold (fun _ l a -> (List.length l)+a) a.phi 0) in
149 let max_tt = ref 0 in
150 let outc = open_out file in
151 let outf = Format.formatter_of_out_channel outc in
152 let strf = Format.str_formatter in
153 let pr_str x = Format.fprintf strf x in
154 let pr_out x = Format.fprintf outf x in
156 if not (Tree.is_nil t) then
157 let tooltip,selected = try
158 let (inconf,outconf,leftres,rightres,trans) = Hashtbl.find h_trace (Tree.id t) in
159 let selected = IntSet.mem (Tree.id t) results in
160 pr_str "<span id=\"id%i\"><table><tr><td>Subtree %i, tag='%s', internal node = %s\nEntered with configuration:\n"
161 (Tree.id t) (Tree.id t) (Tag.to_string (Tree.tag t)) (Tree.dump_node t);
162 iter_pl (fun s -> pr_st strf (Ptset.elements s)) inconf;
163 pr_str "%s" "\nLeft with configuration:\n";
164 iter_pl (fun s -> pr_st strf (Ptset.elements s)) outconf;
165 pr_str "%s" "\nAccept states for left child:\n";
166 iter_pl (fun s -> pr_st strf (Ptset.elements s)) leftres;
167 pr_str "%s" "\nAccept states for right child:\n";
168 iter_pl (fun s -> pr_st strf (Ptset.elements s)) rightres;
169 pr_str "%s" "\nTriggered transitions:\n";
170 pr_str "%s" "<table><tr valign=\"top\">";
172 pr_str "%s" "<td>";pr_frmlst strf fl;pr_str "</td>";
173 max_tt := max !max_tt (form_list_length fl);
175 pr_str "%s" "</td></table>\n";
176 pr_str "In result set : %s\n</td></tr></table></span>" (if selected then "Yes" else "No");
177 Format.flush_str_formatter(),selected
179 Not_found -> "",false
181 let tag = Tree.tag t in
182 let div_class = (if (tooltip = "") then "skipped" else (if selected then "selected" else "touched"))^
183 (if tag == Tag.pcdata then "_text" else"")
185 if tag == Tag.pcdata then
186 pr_out "<div class=\"%s\">%s%s</div>"div_class (Tree.get_text t) tooltip
188 if (Tree.is_nil (Tree.first_child t))
190 pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><%s/>%s</div>"
191 div_class (Tree.id t) (Tree.id t) (Tag.to_string tag) tooltip
193 pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><%s>%s</div>"
194 div_class (Tree.id t) (Tree.id t) (Tag.to_string tag) tooltip;
195 loop (Tree.first_child t);
196 pr_out "<div class=\"%s\"> </%s></div>" div_class (Tag.to_string tag);
199 loop (Tree.next_sibling t);
201 let max_tt = 25*(!max_tt + 12)+20 in
202 let height = max max_tt (25*h_auto) in
203 pr_out html_header height height height height;
204 pr_out "%s" "<div class=\"header\">";
206 pr_out "%s" "</div><div class=\"yellow\" id=\"tooltipzone\"></div>";
207 pr_out "%s" "<div class=\"document\">";
209 pr_out "%s" html_footer;