html_trace.ml

   1 let html_header  = format_of_string
   2             "<!DOCTYPE html
   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\" >
   6
   7 <head>
   8 <meta http-equiv=\"content-type\" content=\"text/html;
   9 charset=utf-8\" />
  10 <style type=\"text/css\" media=\"all\">
  11
  12  hr {
  13  height : 100px;
  14  width : 5px;
  15 }
  16  div {
  17  display:inline;
  18  position: relative;
  19 }
  20
  21   a {
  22   text-decoration:none;
  23   }
  24
  25   span a { text-decoration:underline; }
  26
  27
  28   div[class=\"touched\"] {
  29   color: #008;
  30   text-decoration: none;
  31   }
  32
  33   div[class=\"touched_text\"] {
  34   color: #fff;
  35   background-color: #00a;
  36   white-space : pre;
  37   display:inline;
  38   text-decoration:none;
  39   }
  40
  41   div[class=\"selected\"] {
  42   color: #00f;
  43   background: #ddf;
  44   text-decoration:none;
  45   }
  46
  47   div[class=\"selected_text\"] {
  48   color: #fff;
  49   background-color: #00f;
  50   white-space : pre;
  51   text-decoration:none;
  52   }
  53
  54   div[class=\"skipped_text\"] {
  55    white-space : pre;
  56    display:inline;
  57    color: #555;
  58   }
  59
  60
  61   div[class=\"skipped\"] {
  62   color: #555;
  63   display:inline;
  64   }
  65
  66   div:hover[class=\"skipped\"] {
  67   color: #555;
  68   }
  69
  70
  71   div span {
  72   display: none;
  73   }
  74
  75   div[id=\"tooltipzone\"] span {
  76   display: block;
  77   text-decoration: none;
  78   font-family: monospace;
  79   font-size: 16px;
  80   padding:10px;
  81   overflow:none;
  82   height: %ipx;
  83   background: #ee4;
  84   color: #000;
  85   white-space: pre;
  86   }
  87
  88   div:hover {
  89   display: inline;
  90   }
  91
  92   div[class=\"header\"]{
  93   display:block;
  94   position:fixed;
  95   top: 0px;
  96   width:40%%;
  97   height: %ipx;
  98   overflow: auto;
  99   background-color: white;
 100   z-index:20;
 101   white-space : pre;
 102   font-family: monospace;
 103   font-size : 16px;
 104   padding: 0px;
 105   }
 106
 107   div[class=\"document\"] {
 108   position:fixed;
 109   top: %ipx;
 110   left: 10px;
 111   right: 0px;
 112   bottom: 0px;
 113   overflow: auto;
 114   font-family: monospace;
 115   font-size:14px;
 116   white-space: nowrap;
 117   }
 118
 119   div[class=\"yellow\"] {
 120   display: block;
 121   position: fixed;
 122   top: 0px;
 123   overflow:auto;
 124   left:40%%;
 125   right:0px;
 126   height: %ipx;
 127   padding: 0%%;
 128   background: #ee4;
 129   color: #000;
 130   white-space: pre;
 131   }
 132 </style>
 133 </head>
 134 <body>
 135 <script type=\"text/javascript\">
 136 function ShowPopup(span)
 137 {
 138  if (span != null){
 139  ttz = document.getElementById('tooltipzone');
 140  children = ttz.childNodes;
 141  if (children.length == 1){
 142    id = children[0].id;
 143    newid = \"div\" + id.substring(2);
 144    div = document.getElementById(newid);
 145    div.appendChild(children[0]);
 146  };
 147  ttz.appendChild(span);
 148 }
 149 };
 150
 151
 152 </script>
 153 "
 154 let html_footer = "</div> <!-- document -->
 155 </body>
 156 </html>"
 157 let h_trace = Hashtbl.create 4096
 158 let register_trace t x = Hashtbl.add h_trace (Tree.id t) x
 159 let h_fname = Hashtbl.create 401
 160
 161 let register_funname f s = Hashtbl.add h_fname (Hashtbl.hash  f) s
 162 let get_funname f = try Hashtbl.find h_fname (Hashtbl.hash  f) with _ -> "[anon_fun]"
 163 let tag_to_str tag =
 164   let s = Tag.to_string tag in
 165   let num =ref 0 in
 166     for i=0 to (String.length s)-1 do
 167       match s.[i] with
 168         | '<' | '>' -> incr num
 169         | _ -> ()
 170     done;
 171     if !num == 0 then s
 172     else
 173       let j = ref 0 in
 174       let ns = String.create ((String.length s)+3 * !num) in
 175         for i=0 to (String.length s)-1 do
 176           match s.[i] with
 177             | '<' | '>' as x ->
 178                 ns.[!j] <- '&';
 179                 ns.[!j+1] <- (if x == '>' then 'g' else 'l') ;
 180                 ns.[!j+2] <- 't';
 181                 ns.[!j+3] <- ';';
 182                 j:= !j+4
 183             | _ -> ns.[!j] <- s.[i]; incr j
 184         done;
 185         ns
 186
 187
 188 let output_trace a t file results =
 189   let h_auto = 6+ (Hashtbl.fold (fun _ l a -> (List.length l)+a) a.trans 0) in
 190   let max_tt = ref 0 in
 191   let outc = open_out file in
 192   let outf = Format.formatter_of_out_channel outc in
 193   let strf = Format.str_formatter in
 194   let pr_str x = Format.fprintf strf x in
 195   let pr_out x = Format.fprintf outf x in
 196   let rec loop t =
 197     if not (Tree.is_nil t) then
 198       let id = Tree.id t in
 199       let tag = Tree.tag t in
 200       let tooltip,selected = try
 201         let (inconf,outconf,trans,first_fun,next_fun,ctx) = Hashtbl.find h_trace id in
 202         let selected = IntSet.mem id results in
 203           pr_str "<span id=\"id%i\"><table><tr><td>Subtree %i, tag='%s', internal node = %s\n"
 204             id id  (tag_to_str tag) (Tree.dump_node t);
 205
 206           pr_str "Context node is %i, tag='%s', internal node = '%s'\n"
 207             (Tree.id ctx) (tag_to_str (Tree.tag ctx)) (Tree.dump_node ctx);
 208           pr_str "%s" "\nEntered with configuration:\n";
 209           SList.iter (fun s -> StateSet.print strf s) inconf;
 210           pr_str "%s" "\nLeft with configuration:\n";
 211           SList.iter (fun s -> StateSet.print strf s) outconf;
 212           (let ft = first_fun t in
 213              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"
 214                (Tree.id ft) (Tree.id ft) (Tree.id ft) (tag_to_str (Tree.tag ft)) (Tree.dump_node ft);
 215              pr_str "Moving with : %s (tree=%i)\n" (get_funname first_fun) id;
 216           );
 217           (let nt = next_fun t ctx in
 218              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"
 219                (Tree.id nt) (Tree.id nt) (Tree.id nt) (tag_to_str (Tree.tag nt)) (Tree.dump_node nt);
 220              pr_str "Moving with : %s (tree=%i) (ctx=%i)\n" (get_funname first_fun) id (Tree.id ctx);
 221           );
 222           pr_str "%s" "\nTriggered transitions:\n";
 223           pr_str "%s" "<table><tr valign=\"top\">";
 224           List.iter (fun fl ->
 225                        pr_str "%s" "<td>";Formlist.print strf fl;pr_str "</td>";
 226                        max_tt := max !max_tt (Formlist.length fl);
 227                     ) trans;
 228           pr_str "%s" "</td></table>\n";
 229           pr_str "In result set : %s\n</td></tr></table></span>" (if selected then  "Yes" else "No");
 230           Format.flush_str_formatter(),selected
 231       with
 232           Not_found -> "",false
 233       in
 234       let div_class = (if (tooltip = "") then "skipped" else (if selected then "selected" else "touched"))^
 235         (if tag == Tag.pcdata || tag== Tag.attribute_data then "_text" else"")
 236       in
 237         if tag == Tag.pcdata || tag== Tag.attribute_data then
 238           pr_out "<div class=\"%s\"><a name=\"l%i\"/>%s%s</div>" div_class id (Tree.get_text t) tooltip
 239         else begin
 240           if (Tree.is_nil (Tree.first_child t))
 241           then
 242             pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/>&lt;%s/&gt;%s</div>"
 243               div_class id id id (tag_to_str tag) tooltip
 244           else begin
 245             pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/>&lt;%s&gt;%s</div>"
 246               div_class id id id (tag_to_str tag) tooltip;
 247             loop (Tree.first_child t);
 248             if (tooltip="") then
 249               pr_out "<div class=\"%s\">&lt;/%s&gt;</div>" div_class (tag_to_str tag)
 250             else
 251               pr_out "<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><div class=\"%s\">&lt;/%s&gt;</div></a>" id id  div_class (tag_to_str tag);
 252           end;
 253         end;
 254         loop (Tree.next_sibling t);
 255   in
 256   let max_tt = 25*(!max_tt + 15)+20 in
 257   let height = max max_tt (25*h_auto) in
 258     pr_out html_header height height height height;
 259     pr_out "%s" "<div class=\"header\">";
 260     pr_out "query: %s\n" a.query_string;
 261     dump outf a;
 262     pr_out "%s"  "</div><hr  /><div class=\"yellow\" id=\"tooltipzone\"></div>";
 263     pr_out "%s" "<div class=\"document\">";
 264     loop t;
 265     pr_out "%s" html_footer;
 266     pr_out "%!";
 267     close_out outc
 268