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 r_trace = Hashtbl.create 4096
 159 let register_trace tree t x =
 160   Hashtbl.add h_trace (Tree.id tree t) x
 161
 162 module HFname = Hashtbl.Make (struct
 163                                 type t = Obj.t
 164                                 let hash = Hashtbl.hash
 165                                 let equal = (==)
 166                               end)
 167
 168 let h_fname = HFname.create 401
 169
 170 let register_funname f s =
 171   HFname.add h_fname (Obj.repr  f) s
 172 let get_funname f = try HFname.find h_fname  (Obj.repr f) with _ -> "[anon_fun]"
 173 let tag_to_str tag =
 174   let s = Tag.to_string tag in
 175   let num =ref 0 in
 176     for i=0 to (String.length s)-1 do
 177       match s.[i] with
 178         | '<' | '>' -> incr num
 179         | _ -> ()
 180     done;
 181     if !num == 0 then s
 182     else
 183       let j = ref 0 in
 184       let ns = String.create ((String.length s)+3 * !num) in
 185         for i=0 to (String.length s)-1 do
 186           match s.[i] with
 187             | '<' | '>' as x ->
 188                 ns.[!j] <- '&';
 189                 ns.[!j+1] <- (if x == '>' then 'g' else 'l') ;
 190                 ns.[!j+2] <- 't';
 191                 ns.[!j+3] <- ';';
 192                 j:= !j+4
 193             | _ -> ns.[!j] <- s.[i]; incr j
 194         done;
 195         ns
 196
 197
 198 let output_trace a tree file results =
 199   let h_auto = 6+ (Hashtbl.fold (fun _ l a -> (List.length l)+a) a.trans 0) in
 200   let max_tt = ref 0 in
 201   let outc = open_out file in
 202   let outf = Format.formatter_of_out_channel outc in
 203   let strf = Format.str_formatter in
 204   let pr_str x = Format.fprintf strf x in
 205   let pr_out x = Format.fprintf outf x in
 206   let rec loop t =
 207     if not (Tree.is_nil t) then
 208     let id = Tree.id tree t in
 209       let tag = Tree.tag tree t in
 210       let tooltip,selected = try
 211         let (inconf,outconf,trans,first_fun,next_fun,ctx) = Hashtbl.find h_trace id in
 212         let selected = IntSet.mem id results in
 213           pr_str "<span id=\"id%i\"><table><tr><td>Subtree %i, tag='%s', internal node = %s\n"
 214             id id  (tag_to_str tag) (Tree.dump_node t);
 215           pr_str "Context node is %i, tag='%s', internal node = '%s'\n"
 216             (Tree.id tree ctx) (tag_to_str (Tree.tag tree ctx)) (Tree.dump_node ctx);
 217           pr_str "%s" "\nEntered with configuration:\n";
 218           SList.iter (fun s -> StateSet.print strf s) inconf;
 219           pr_str "%s" "\nLeft with configuration:\n";
 220           SList.iter (fun s -> StateSet.print strf s) outconf;
 221           (let ft = first_fun t in
 222              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"
 223                (Tree.id tree ft) (Tree.id tree ft) (Tree.id tree ft) (tag_to_str (Tree.tag tree ft)) (Tree.dump_node ft);
 224              pr_str "Moving with : %s (tree=%i)\n" (get_funname first_fun) id;
 225           );
 226           (let nt = next_fun t ctx in
 227              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"
 228                (Tree.id tree nt) (Tree.id tree nt) (Tree.id tree nt) (tag_to_str (Tree.tag tree nt)) (Tree.dump_node nt);
 229              pr_str "Moving with : %s (tree=%i) (ctx=%i)\n" (get_funname next_fun) id (Tree.id tree ctx);
 230           );
 231           pr_str "%s" "\nTriggered transitions:\n";
 232           pr_str "%s" "<table><tr valign=\"top\">";
 233           Formlistlist.iter (fun fl ->
 234                        pr_str "%s" "<td>";Formlist.print strf fl;pr_str "</td>";
 235                        max_tt := max !max_tt (Formlist.length fl);
 236                     ) trans;
 237           pr_str "%s" "</td></table>\n";
 238           pr_str "In result set : %s\n</td></tr></table></span>" (if selected then  "Yes" else "No");
 239           Format.flush_str_formatter(),selected
 240       with
 241           Not_found -> "",false
 242       in
 243       let div_class = (if (tooltip = "") then "skipped" else (if selected then "selected" else "touched"))^
 244         (if tag == Tag.pcdata || tag== Tag.attribute_data then "_text" else"")
 245       in
 246         if tag == Tag.pcdata || tag== Tag.attribute_data then
 247           pr_out "<div class=\"%s\"><a name=\"l%i\"/>%s%s</div>" div_class id (Tree.get_text tree t) tooltip
 248         else begin
 249           if (Tree.is_nil (Tree.first_child tree t))
 250           then
 251             pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/>&lt;%s/&gt;%s</div>"
 252               div_class id id id (tag_to_str tag) tooltip
 253           else begin
 254             pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/>&lt;%s&gt;%s</div>"
 255               div_class id id id (tag_to_str tag) tooltip;
 256             loop (Tree.first_child tree t);
 257             if (tooltip="") then
 258               pr_out "<div class=\"%s\">&lt;/%s&gt;</div>" div_class (tag_to_str tag)
 259             else
 260               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);
 261           end;
 262         end;
 263         loop (Tree.next_sibling tree t);
 264   in
 265   let max_tt = 25*(!max_tt + 15)+20 in
 266   let height = max max_tt (25*h_auto) in
 267     pr_out html_header height height height height;
 268     pr_out "%s" "<div class=\"header\">";
 269     pr_out "query: %s\n" a.query_string;
 270     dump outf a;
 271     pr_out "%s"  "</div><hr  /><div class=\"yellow\" id=\"tooltipzone\"></div>";
 272     pr_out "%s" "<div class=\"document\">";
 273     loop (Tree.root);
 274     pr_out "%s" html_footer;
 275     pr_out "%!";
 276     close_out outc
 277