+++ /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 r_trace = Hashtbl.create 4096
-let register_trace tree t x =
- Hashtbl.add h_trace (Tree.id tree t) x
-
-module HFname = Hashtbl.Make (struct
- type t = Obj.t
- let hash = Hashtbl.hash
- let equal = (==)
- end)
-
-let h_fname = HFname.create 401
-
-let register_funname f s =
- HFname.add h_fname (Obj.repr f) s
-let get_funname f = try HFname.find h_fname (Obj.repr 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 tree 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 tree t in
- let tag = Tree.tag tree 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 tree ctx) (tag_to_str (Tree.tag tree 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 tree ft) (Tree.id tree ft) (Tree.id tree ft) (tag_to_str (Tree.tag tree 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 tree nt) (Tree.id tree nt) (Tree.id tree nt) (tag_to_str (Tree.tag tree nt)) (Tree.dump_node nt);
- pr_str "Moving with : %s (tree=%i) (ctx=%i)\n" (get_funname next_fun) id (Tree.id tree ctx);
- );
- pr_str "%s" "\nTriggered transitions:\n";
- pr_str "%s" "<table><tr valign=\"top\">";
- Formlistlist.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 tree t) tooltip
- else begin
- if (Tree.is_nil (Tree.first_child tree 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 tree 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 tree 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 (Tree.root);
- pr_out "%s" html_footer;
- pr_out "%!";
- close_out outc
-
projects / SXSI / xpathcomp.git / blobdiff