html_header.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  div {
  13  display:inline;
  14  position: relative;
  15 }
  16
  17   div[class=\"touched\"] {
  18   color: #008;
  19   text-decoration: none;
  20   }
  21
  22   div[class=\"touched_text\"] {
  23   color: #fff;
  24   background-color: #00a;
  25   white-space : pre;
  26   display:inline;
  27   text-decoration:none;
  28   }
  29
  30   div[class=\"selected\"] {
  31   color: #00f;
  32   background: #ddf;
  33   }
  34
  35   div[class=\"selected_text\"] {
  36   color: #fff;
  37   background-color: #00f;
  38   white-space : pre;
  39   }
  40
  41   div[class=\"skipped_text\"] {
  42    white-space : pre;
  43    display:inline;
  44    color: #555;
  45   }
  46
  47
  48   div[class=\"skipped\"] {
  49   color: #555;
  50    display:inline;
  51   }
  52
  53   div:hover[class=\"skipped\"] {
  54   color: #555;
  55   }
  56
  57
  58   div span {
  59   display: none;
  60   }
  61
  62   div[id=\"tooltipzone\"] span {
  63   display: block;
  64   text-decoration: none;
  65   font-family: monospace;
  66   font-size: 16px;
  67   padding:10px;
  68   overflow:auto;
  69   height: %ipx;
  70   background: #ee4;
  71   color: #000;
  72   white-space: pre;
  73   }
  74
  75   div:hover {
  76   display: inline;
  77   }
  78
  79
  80   div[class=\"header\"]{
  81   display:block;
  82   position:fixed;
  83   top: 0px;
  84   width:40%%;
  85   height: %ipx;
  86   overflow: auto;
  87   background-color: white;
  88   z-index:20;
  89   white-space : pre;
  90   font-family: monospace;
  91   font-size : 16px;
  92   padding: 0px;
  93   }
  94
  95   div[class=\"document\"] {
  96   position:fixed;
  97   top: %ipx;
  98   left: 10px;
  99   right: 0px;
 100   bottom: 0px;
 101   overflow: auto;
 102   font-family: monospace;
 103   font-size:14px;
 104   white-space: nowrap;
 105   }
 106
 107   div[class=\"yellow\"] {
 108   display: block;
 109   position: fixed;
 110   top: 0px;
 111   overflow:auto;
 112   left:40%%;
 113   right:0px;
 114   height: %ipx;
 115   padding: 0%%;
 116   background: #ee4;
 117   color: #000;
 118   white-space: pre;
 119   }
 120 </style>
 121 </head>
 122 <body>
 123 <script type=\"text/javascript\">
 124 function ShowPopup(span)
 125 {
 126  ttz = document.getElementById('tooltipzone');
 127  children = ttz.childNodes;
 128  if (children.length == 1){
 129    id = children[0].id;
 130    newid = \"div\" + id.substring(2);
 131    div = document.getElementById(newid);
 132    div.appendChild(children[0]);
 133  };
 134  ttz.appendChild(span);
 135 };
 136
 137
 138 </script>
 139 "
 140 let html_footer = "</div> <!-- document -->
 141 </body>
 142 </html>"
 143       let h_trace = Hashtbl.create 4096
 144       let register_trace t x = Hashtbl.add h_trace (Tree.id t) x
 145
 146
 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
 155           let rec loop t =
 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\">";
 171                   List.iter (fun fl ->
 172                                pr_str "%s" "<td>";pr_frmlst strf fl;pr_str "</td>";
 173                                max_tt := max !max_tt (form_list_length fl);
 174                             ) trans;
 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
 178               with
 179                   Not_found -> "",false
 180               in
 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"")
 184               in
 185                 if tag == Tag.pcdata then
 186                   pr_out "<div class=\"%s\">%s%s</div>"div_class (Tree.get_text t) tooltip
 187                 else begin
 188                   if (Tree.is_nil (Tree.first_child t))
 189                   then
 190                     pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">&lt;%s/&gt;%s</div>"
 191                        div_class (Tree.id t) (Tree.id t) (Tag.to_string tag) tooltip
 192                   else begin
 193                     pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">&lt;%s&gt;%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\"> &lt;/%s&gt;</div>" div_class (Tag.to_string tag);
 197                   end;
 198                 end;
 199                 loop (Tree.next_sibling t);
 200           in
 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\">";
 205             dump outf a;
 206             pr_out "%s"  "</div><div class=\"yellow\" id=\"tooltipzone\"></div>";
 207             pr_out "%s" "<div class=\"document\">";
 208             loop t;
 209             pr_out "%s" html_footer;
 210             pr_out "%!";
 211             close_out outc