let html_header = format_of_string " " let html_footer = " " let h_trace = Hashtbl.create 4096 let register_trace t x = Hashtbl.add h_trace (Tree.id t) x let h_fname = Hashtbl.create 401 let register_funname f s = Hashtbl.add h_fname (Hashtbl.hash f) s let get_funname f = try Hashtbl.find h_fname (Hashtbl.hash 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 t 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 t in let tag = Tree.tag 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 "

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 ctx) (tag_to_str (Tree.tag 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 "\nLeft successor is: id=%i, tag='%s', internal node = '%s'\n" (Tree.id ft) (Tree.id ft) (Tree.id ft) (tag_to_str (Tree.tag 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 "\nRight successor is: id=%i, tag='%s', internal node = '%s'\n" (Tree.id nt) (Tree.id nt) (Tree.id nt) (tag_to_str (Tree.tag nt)) (Tree.dump_node nt); pr_str "Moving with : %s (tree=%i) (ctx=%i)\n" (get_funname first_fun) id (Tree.id ctx); ); pr_str "%s" "\nTriggered transitions:\n"; pr_str "%s" ""; List.iter (fun fl -> pr_str "%s" ""; max_tt := max !max_tt (Formlist.length fl); ) trans; pr_str "%s" "

";Formlist.print strf fl;pr_str "

\n"; pr_str "In result set : %s\n

" (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 "

%s%s

" div_class id (Tree.get_text t) tooltip else begin if (Tree.is_nil (Tree.first_child t)) then pr_out "

<%s/>%s

" div_class id id id (tag_to_str tag) tooltip else begin pr_out "

<%s>%s

" div_class id id id (tag_to_str tag) tooltip; loop (Tree.first_child t); if (tooltip="") then pr_out "

</%s>

" div_class (tag_to_str tag) else pr_out "

</%s>

" id id div_class (tag_to_str tag); end; end; loop (Tree.next_sibling 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" "

"; pr_out "%s" "

"; loop t; pr_out "%s" html_footer; pr_out "%!"; close_out outc