Remove trailing white spaces
[SXSI/xpathcomp.git] / 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