--- /dev/null
+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\">
+
+ hr {
+ height : 100px;
+ width : 5px;
+}
+ div {
+ display:inline;
+ position: relative;
+}
+
+ a {
+ text-decoration:none;
+ }
+
+ span a { text-decoration:underline; }
+
+
+ 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;
+ text-decoration:none;
+ }
+
+ div[class=\"selected_text\"] {
+ color: #fff;
+ background-color: #00f;
+ white-space : pre;
+ text-decoration:none;
+ }
+
+ 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:none;
+ 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)
+{
+ if (span != null){
+ 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 h_fname = Hashtbl.create 401
+
+let register_funname f s = Hashtbl.add h_fname (Hashtbl.hash f) s
+let get_funname f = try Hashtbl.find h_fname (Hashtbl.hash f) with _ -> "[anon_fun]"
+let tag_to_str tag =
+ let s = Tag.to_string tag in
+ let num =ref 0 in
+ for i=0 to (String.length s)-1 do
+ match s.[i] with
+ | '<' | '>' -> incr num
+ | _ -> ()
+ done;
+ if !num == 0 then s
+ else
+ let j = ref 0 in
+ let ns = String.create ((String.length s)+3 * !num) in
+ for i=0 to (String.length s)-1 do
+ match s.[i] with
+ | '<' | '>' as x ->
+ ns.[!j] <- '&';
+ ns.[!j+1] <- (if x == '>' then 'g' else 'l') ;
+ ns.[!j+2] <- 't';
+ ns.[!j+3] <- ';';
+ j:= !j+4
+ | _ -> ns.[!j] <- s.[i]; incr j
+ done;
+ ns
+
+
+let output_trace a t file results =
+ let h_auto = 6+ (Hashtbl.fold (fun _ l a -> (List.length l)+a) a.trans 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 id = Tree.id t in
+ let tag = Tree.tag t in
+ let tooltip,selected = try
+ let (inconf,outconf,trans,first_fun,next_fun,ctx) = Hashtbl.find h_trace id in
+ let selected = IntSet.mem id results in
+ pr_str "<span id=\"id%i\"><table><tr><td>Subtree %i, tag='%s', internal node = %s\n"
+ id id (tag_to_str tag) (Tree.dump_node t);
+
+ pr_str "Context node is %i, tag='%s', internal node = '%s'\n"
+ (Tree.id ctx) (tag_to_str (Tree.tag ctx)) (Tree.dump_node ctx);
+ pr_str "%s" "\nEntered with configuration:\n";
+ SList.iter (fun s -> StateSet.print strf s) inconf;
+ pr_str "%s" "\nLeft with configuration:\n";
+ SList.iter (fun s -> StateSet.print strf s) outconf;
+ (let ft = first_fun t in
+ pr_str "\n<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\" >Left successor</a> is: id=%i, tag='%s', internal node = '%s'\n"
+ (Tree.id ft) (Tree.id ft) (Tree.id ft) (tag_to_str (Tree.tag ft)) (Tree.dump_node ft);
+ pr_str "Moving with : %s (tree=%i)\n" (get_funname first_fun) id;
+ );
+ (let nt = next_fun t ctx in
+ pr_str "\n<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">Right successor</a> is: id=%i, tag='%s', internal node = '%s'\n"
+ (Tree.id nt) (Tree.id nt) (Tree.id nt) (tag_to_str (Tree.tag nt)) (Tree.dump_node nt);
+ pr_str "Moving with : %s (tree=%i) (ctx=%i)\n" (get_funname first_fun) id (Tree.id ctx);
+ );
+ pr_str "%s" "\nTriggered transitions:\n";
+ pr_str "%s" "<table><tr valign=\"top\">";
+ List.iter (fun fl ->
+ pr_str "%s" "<td>";Formlist.print strf fl;pr_str "</td>";
+ max_tt := max !max_tt (Formlist.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 div_class = (if (tooltip = "") then "skipped" else (if selected then "selected" else "touched"))^
+ (if tag == Tag.pcdata || tag== Tag.attribute_data then "_text" else"")
+ in
+ if tag == Tag.pcdata || tag== Tag.attribute_data then
+ pr_out "<div class=\"%s\"><a name=\"l%i\"/>%s%s</div>" div_class id (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'));\"><a name=\"l%i\"/><%s/>%s</div>"
+ div_class id id id (tag_to_str tag) tooltip
+ else begin
+ pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/><%s>%s</div>"
+ div_class id id id (tag_to_str tag) tooltip;
+ loop (Tree.first_child t);
+ if (tooltip="") then
+ pr_out "<div class=\"%s\"></%s></div>" div_class (tag_to_str tag)
+ else
+ pr_out "<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><div class=\"%s\"></%s></div></a>" id id div_class (tag_to_str tag);
+ end;
+ end;
+ loop (Tree.next_sibling t);
+ in
+ let max_tt = 25*(!max_tt + 15)+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\">";
+ pr_out "query: %s\n" a.query_string;
+ dump outf a;
+ pr_out "%s" "</div><hr /><div class=\"yellow\" id=\"tooltipzone\"></div>";
+ pr_out "%s" "<div class=\"document\">";
+ loop t;
+ pr_out "%s" html_footer;
+ pr_out "%!";
+ close_out outc
+
projects / SXSI / xpathcomp.git / blobdiff