New files refactoring the code
[SXSI/xpathcomp.git] / html_header.ml
diff --git a/html_header.ml b/html_header.ml
new file mode 100644 (file)
index 0000000..f2b1a8e
--- /dev/null
@@ -0,0 +1,211 @@
+let html_header  = format_of_string
+           "<!DOCTYPE html 
+     PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
+     \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\" >
+
+<head>
+<meta http-equiv=\"content-type\" content=\"text/html;
+charset=utf-8\" />
+<style type=\"text/css\" media=\"all\">
+
+ div { 
+ display:inline;
+ position: relative;
+}
+
+  div[class=\"touched\"] { 
+  color: #008;
+  text-decoration: none;
+  }
+  div[class=\"touched_text\"] { 
+  color: #fff;
+  background-color: #00a;  
+  white-space : pre;
+  display:inline;
+  text-decoration:none;
+  }
+
+  div[class=\"selected\"] { 
+  color: #00f;
+  background: #ddf;
+  }
+  div[class=\"selected_text\"] { 
+  color: #fff;
+  background-color: #00f;
+  white-space : pre;
+  }
+
+  div[class=\"skipped_text\"] {
+   white-space : pre;
+   display:inline;
+   color: #555;
+  }
+
+  
+  div[class=\"skipped\"] { 
+  color: #555;
+   display:inline;
+  }
+  
+  div:hover[class=\"skipped\"] { 
+  color: #555;
+  }
+    
+
+  div span {
+  display: none;
+  }
+
+  div[id=\"tooltipzone\"] span {
+  display: block;
+  text-decoration: none;
+  font-family: monospace;
+  font-size: 16px;
+  padding:10px;
+  overflow:auto;
+  height: %ipx;
+  background: #ee4;
+  color: #000;
+  white-space: pre;
+  }
+  
+  div:hover {
+  display: inline;
+  }
+
+
+  div[class=\"header\"]{
+  display:block;
+  position:fixed;
+  top: 0px;
+  width:40%%;
+  height: %ipx;
+  overflow: auto;
+  background-color: white;
+  z-index:20;
+  white-space : pre;
+  font-family: monospace;
+  font-size : 16px;
+  padding: 0px;
+  }
+
+  div[class=\"document\"] {
+  position:fixed;
+  top: %ipx;
+  left: 10px;
+  right: 0px;
+  bottom: 0px;
+  overflow: auto;
+  font-family: monospace;
+  font-size:14px;  
+  white-space: nowrap;
+  }
+
+  div[class=\"yellow\"] {
+  display: block;
+  position: fixed;
+  top: 0px;
+  overflow:auto;
+  left:40%%;
+  right:0px;
+  height: %ipx;
+  padding: 0%%;
+  background: #ee4;
+  color: #000;
+  white-space: pre;
+  }
+</style>
+</head>
+<body>
+<script type=\"text/javascript\">
+function ShowPopup(span)
+{
+ ttz = document.getElementById('tooltipzone');  
+ children = ttz.childNodes;
+ if (children.length == 1){
+   id = children[0].id;
+   newid = \"div\" + id.substring(2);
+   div = document.getElementById(newid);
+   div.appendChild(children[0]);
+ };
+ ttz.appendChild(span); 
+};
+
+
+</script>
+"
+let html_footer = "</div> <!-- document -->
+</body>
+</html>"
+      let h_trace = Hashtbl.create 4096
+      let register_trace t x = Hashtbl.add h_trace (Tree.id t) x
+
+
+      let output_trace a t file results =
+       let h_auto = 6+ (Hashtbl.fold (fun _ l a -> (List.length l)+a) a.phi 0) in
+       let max_tt = ref 0 in
+       let outc = open_out file in
+       let outf = Format.formatter_of_out_channel outc in
+       let strf = Format.str_formatter in
+       let pr_str x = Format.fprintf strf x in
+       let pr_out x = Format.fprintf outf x in
+         let rec loop t = 
+           if not (Tree.is_nil t) then
+             let tooltip,selected = try 
+               let (inconf,outconf,leftres,rightres,trans) = Hashtbl.find h_trace (Tree.id t) in
+               let selected = IntSet.mem (Tree.id t) results in
+                 pr_str "<span id=\"id%i\"><table><tr><td>Subtree %i, tag='%s', internal node = %s\nEntered with configuration:\n" 
+                 (Tree.id t) (Tree.id t)  (Tag.to_string (Tree.tag t)) (Tree.dump_node t);
+                 iter_pl (fun s -> pr_st strf (Ptset.elements s)) inconf;
+                 pr_str "%s" "\nLeft with configuration:\n";
+                 iter_pl (fun s -> pr_st strf (Ptset.elements s)) outconf;
+                 pr_str "%s" "\nAccept states for left child:\n";
+                 iter_pl (fun s -> pr_st strf (Ptset.elements s)) leftres;
+                 pr_str "%s" "\nAccept states for right child:\n";
+                 iter_pl (fun s -> pr_st strf (Ptset.elements s)) rightres;              
+                 pr_str "%s" "\nTriggered transitions:\n";
+                 pr_str "%s" "<table><tr valign=\"top\">";
+                 List.iter (fun fl ->
+                              pr_str "%s" "<td>";pr_frmlst strf fl;pr_str "</td>";
+                              max_tt := max !max_tt (form_list_length fl);
+                           ) trans;
+                 pr_str "%s" "</td></table>\n";
+                 pr_str "In result set : %s\n</td></tr></table></span>" (if selected then  "Yes" else "No");
+                 Format.flush_str_formatter(),selected
+             with
+                 Not_found -> "",false
+             in
+             let tag = Tree.tag t in
+             let div_class = (if (tooltip = "") then "skipped" else (if selected then "selected" else "touched"))^
+               (if tag == Tag.pcdata then "_text" else"")
+             in
+               if tag == Tag.pcdata then 
+                 pr_out "<div class=\"%s\">%s%s</div>"div_class (Tree.get_text t) tooltip
+               else begin
+                 if (Tree.is_nil (Tree.first_child t))
+                 then
+                   pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">&lt;%s/&gt;%s</div>" 
+                      div_class (Tree.id t) (Tree.id t) (Tag.to_string tag) tooltip
+                 else begin
+                    pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">&lt;%s&gt;%s</div>" 
+                      div_class (Tree.id t) (Tree.id t) (Tag.to_string tag) tooltip;
+                   loop (Tree.first_child t);
+                   pr_out "<div class=\"%s\"> &lt;/%s&gt;</div>" div_class (Tag.to_string tag);
+                 end;
+               end;
+               loop (Tree.next_sibling t);
+         in
+         let max_tt = 25*(!max_tt + 12)+20 in
+         let height = max max_tt (25*h_auto) in
+           pr_out html_header height height height height;
+           pr_out "%s" "<div class=\"header\">";
+           dump outf a;
+           pr_out "%s"  "</div><div class=\"yellow\" id=\"tooltipzone\"></div>";
+           pr_out "%s" "<div class=\"document\">";
+           loop t;
+           pr_out "%s" html_footer;
+           pr_out "%!";
+           close_out outc