Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit 686734b2 authored by bguillaum's avatar bguillaum

more links in html files

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7457 7838e531-6607-4d57-9587-6c381814729c
parent 8a38da57
......@@ -28,10 +28,6 @@ module Rewrite_history = struct
| { good_nf = l} -> List.fold_left (fun acc t -> acc + (num_sol t)) 0 l
(** [save_nfs ?main_feat base_name t] does two things:
- write PNG files of normal forms
- returns a list of couples (rules, file)
*)
let save_nfs ?main_feat ~dot base_name t =
let rec loop file_name rules t =
match (t.good_nf, t.bad_nf) with
......@@ -52,36 +48,6 @@ module Rewrite_history = struct
in loop base_name [] t
let error_html ?main_feat ?(dot=false) ?(init_graph=true) ?header prefix msg inst_opt =
(* remove files from previous runs *)
let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in
(match inst_opt, init_graph with
| (Some inst, true) when dot -> Instance.save_dot_png ?main_feat prefix inst
| (Some inst, true) -> Instance.save_dep_png ?main_feat prefix inst
| _ -> ()
);
let local = Filename.basename prefix in
(* All normal forms view *)
let html_ch = open_out (sprintf "%s.html" prefix) in
let title = sprintf "Sentence: %s --- ERROR" local in
let () = Html.enter html_ch ~title ?header prefix in
if init_graph
then
begin
fprintf html_ch "<h6>Initial graph</h6>\n";
fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local
end;
fprintf html_ch "<h2>ERROR: %s</h2>\n" msg;
Html.leave html_ch;
close_out html_ch
let save_gr base t =
let rec loop file_name t =
match (t.good_nf, t.bad_nf) with
......@@ -89,78 +55,6 @@ module Rewrite_history = struct
| l, _ -> List_.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
in loop base t
let save_html ?main_feat ?(dot=false) ?(init_graph=true) ?(out_gr=false) ?header ~graph_file prefix t =
(* remove files from previous runs *)
let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in
(if init_graph then Instance.save_dep_png ?main_feat prefix t.instance);
let nf_files = save_nfs ?main_feat ~dot prefix t in
let l = List.length nf_files in
let local = Filename.basename prefix in
(* All normal forms view *)
let html_ch = open_out (sprintf "%s.html" prefix) in
let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
let () = Html.enter html_ch ~title ?header prefix in
fprintf html_ch "<b>Input file</b>: <a href=\"%s\">%s</a><br/>\n"
graph_file (Filename.basename graph_file);
fprintf html_ch "<b>Input sentence</b>: <font color=\"green\"><i>%s</i></font></p><br/>\n"
(G_graph.to_sentence ?main_feat t.instance.Instance.graph);
if init_graph
then
begin
fprintf html_ch "<h6>Initial graph</h6>\n";
fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local
end;
List_.iteri
(fun i (rules_list,file_name) ->
fprintf html_ch "<h6>Solution %d</h6>\n" (i+1);
let local_name = Filename.basename file_name in
if out_gr
then fprintf html_ch "<p><a href=\"%s.gr\">gr file</a>\n" local_name;
(* the png file *)
fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local_name;
(* the modules list *)
fprintf html_ch "<b>Modules applied</b>: %d<br/>\n" (List.length rules_list);
let id = sprintf "id_%d" (i+1) in
fprintf html_ch "<a style=\"cursor:pointer;\"\n";
fprintf html_ch " onClick=\"if (document.getElementById('%s').style.display == 'none')\n" id;
fprintf html_ch " { document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = 'Hide applied rules'; }\n" id id;
fprintf html_ch " else { document.getElementById('%s').style.display = 'none';; document.getElementById('p_%s').innerHTML = 'Show applied rules'; }\">" id id;
fprintf html_ch " <b><p id=\"p_%s\">Show applied rules</p></b>\n" id;
fprintf html_ch "</a>\n";
fprintf html_ch " <div id=\"%s\" style=\"display:none;\">\n" id;
List.iter
(fun (mod_name,rules) ->
fprintf html_ch "<p><b><font color=\"red\">%s: </font></b><font color=\"green\">%s</font></p>\n"
mod_name
(List_.to_string (fun x -> x) ", " rules);
)
rules_list;
fprintf html_ch " </div>\n"
) nf_files;
Html.leave html_ch;
close_out html_ch
end
......
......@@ -15,26 +15,16 @@ module Rewrite_history: sig
val num_sol: t -> int
val error_html:
(** [save_nfs ?main_feat base_name t] does two things:
- write PNG files of normal forms
- returns a list of couples (rules, file)
*)
val save_nfs:
?main_feat: string ->
?dot: bool ->
?init_graph:bool ->
?header:string ->
string ->
string ->
Instance.t option ->
unit
val save_html:
?main_feat: string ->
?dot: bool ->
?init_graph:bool ->
?out_gr:bool ->
?header:string ->
graph_file:string ->
dot: bool ->
string ->
t ->
unit
((string * string list) list * string) list
val save_gr: string -> t -> unit
end
......
......@@ -3,11 +3,12 @@ open Log
open Grew_utils
open Grew_ast
open Grew_graph
open Grew_rule
open Grew_grs
let header ?title buff =
let html_header ?title buff =
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
wnl "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">";
......@@ -161,7 +162,7 @@ module Html_doc = struct
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Module %s" module_.Ast.module_id in
header ~title buff;
html_header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">";
......@@ -196,7 +197,7 @@ module Html_doc = struct
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Rule %s/%s" mid rid in
header ~title buff;
html_header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">";
......@@ -266,7 +267,7 @@ module Html_doc = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- List of sequences" in
header ~title buff;
html_header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
......@@ -292,7 +293,7 @@ module Html_doc = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- Index of modules" in
header ~title buff;
html_header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
......@@ -323,7 +324,7 @@ module Html_doc = struct
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Features domain" in
header ~title buff;
html_header ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
......@@ -368,7 +369,7 @@ module Html_doc = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- Graph Rewriting System: %s" (Filename.basename file) in
header ~title buff;
html_header ~title buff;
wnl " <body>";
wnl "<a href=\"../sentences.html\">Sentences</a> -- <a href=\"../index.html\">Rewriting stats</a> -- GRS documentation";
......@@ -450,29 +451,165 @@ module Html_doc = struct
done
end
module Html_rh = struct
let build ?main_feat ?(dot=false) ?(init_graph=true) ?(out_gr=false) ?header ~graph_file prefix t =
(* remove files from previous runs *)
let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in
(if init_graph then Instance.save_dep_png ?main_feat prefix t.Rewrite_history.instance);
let nf_files = Rewrite_history.save_nfs ?main_feat ~dot prefix t in
let l = List.length nf_files in
let local = Filename.basename prefix in
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
html_header ~title buff;
wnl "<body>";
wnl "<a href=\"sentences.html\">Sentences</a> -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";
wnl "<h1>%s</h1>" title;
begin
match header with
| Some h -> wnl "%s</br>" h
| None -> ()
end;
wnl "<b>Input file</b>: <a href=\"%s\">%s</a><br/>"
graph_file (Filename.basename graph_file);
wnl "<b>Input sentence</b>: <font color=\"green\"><i>%s</i></font></p><br/>"
(G_graph.to_sentence ?main_feat t.Rewrite_history.instance.Instance.graph);
if init_graph
then
begin
wnl "<h6>Initial graph</h6>";
wnl "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>" local
end;
List_.iteri
(fun i (rules_list,file_name) ->
wnl "<h6>Solution %d</h6>" (i+1);
let local_name = Filename.basename file_name in
if out_gr
then wnl "<p><a href=\"%s.gr\">gr file</a>" local_name;
(* the png file *)
wnl "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>" local_name;
(* the modules list *)
wnl "<b>Modules applied</b>: %d<br/>" (List.length rules_list);
let id = sprintf "id_%d" (i+1) in
wnl "<a style=\"cursor:pointer;\"";
wnl " onClick=\"if (document.getElementById('%s').style.display == 'none')" id;
wnl " { document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = 'Hide applied rules'; }" id id;
wnl " else { document.getElementById('%s').style.display = 'none';; document.getElementById('p_%s').innerHTML = 'Show applied rules'; }\">" id id;
wnl " <b><p id=\"p_%s\">Show applied rules</p></b>" id;
wnl "</a>";
wnl " <div id=\"%s\" style=\"display:none;\">" id;
List.iter
(fun (mod_name,rules) ->
wnl "<p><b><font color=\"red\">%s: </font></b><font color=\"green\">%s</font></p>"
mod_name
(List_.to_string (fun x -> x) ", " rules);
)
rules_list;
wnl " </div>"
) nf_files;
wnl "</body>";
wnl "</html>";
let out_ch = open_out (sprintf "%s.html" prefix) in
fprintf out_ch "%s" (Buffer.contents buff);
close_out out_ch
let error ?main_feat ?(dot=false) ?(init_graph=true) ?header prefix msg inst_opt =
(* remove files from previous runs *)
let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in
(match inst_opt, init_graph with
| (Some inst, true) when dot -> Instance.save_dot_png ?main_feat prefix inst
| (Some inst, true) -> Instance.save_dep_png ?main_feat prefix inst
| _ -> ()
);
let local = Filename.basename prefix in
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Sentence: %s --- ERROR" local in
html_header ~title buff;
wnl "<body>";
wnl "<a href=\"sentences.html\">Sentences</a> -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";
wnl "<h1>%s</h1>" title;
if init_graph
then
begin
wnl "<h6>Initial graph</h6>";
wnl "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>" local
end;
wnl "<h2>ERROR: %s</h2>" msg;
wnl "</body>\n</html>";
let out_ch = open_out (sprintf "%s.html" prefix) in
fprintf out_ch "%s" (Buffer.contents buff);
close_out out_ch
end
module Html_sentences = struct
let build output_dir sentences =
let buff = Buffer.create 32 in
header ~title:"Sentence list" buff;
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
html_header ~title:"Sentence list" buff;
bprintf buff " <body>";
bprintf buff "Sentences -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>\n";
bprintf buff "<h2>Sentences list</h2>\n";
wnl " <body>";
wnl "Sentences -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";
wnl "<h2>Sentences list</h2>";
bprintf buff "<center><table cellpadding=3 cellspacing=0 width=\"95%%\">\n";
bprintf buff "<tr><th class=\"first\">Number of normal forms</th><th>Sentence</th></tr>\n";
wnl "<center><table cellpadding=3 cellspacing=0 width=\"95%%\">";
wnl "<tr><th class=\"first\">Number of normal forms</th><th>Sentence</th></tr>";
List.iter
(fun (base_name_opt, amb, sentence) ->
bprintf buff "<tr>\n";
bprintf buff " <td class=\"first_stats\">%d</td>\n" amb;
wnl "<tr>";
wnl " <td class=\"first_stats\">%d</td>" amb;
(match base_name_opt with
| Some base_name -> bprintf buff " <td class=\"stats\"><a href=\"%s.html\">%s</a></td>\n" base_name sentence
| None -> bprintf buff " <td class=\"stats\">%s</td>\n" sentence);
bprintf buff "</tr>\n";
| Some base_name -> wnl " <td class=\"stats\"><a href=\"%s.html\">%s</a></td>" base_name sentence
| None -> wnl " <td class=\"stats\">%s</td>" sentence);
wnl "</tr>";
) sentences;
bprintf buff "</table></center>\n";
wnl "</table></center>";
wnl "</body>";
wnl "</html>";
let out_ch = open_out (Filename.concat output_dir "sentences.html") in
fprintf out_ch "%s" (Buffer.contents buff);
......
open Grew_ast
open Grew_rule
open Grew_grs
module Html_doc :
sig
val build: dep:bool -> string -> string -> Ast.grs -> unit
end
module Html_doc : sig
val build: dep:bool -> string -> string -> Ast.grs -> unit
end
module Html_sentences : sig
val build: string -> (string option * int * string) list -> unit
end
module Html_sentences :
sig
val build: string -> (string option * int * string) list -> unit
end
module Html_rh: sig
val build:
?main_feat: string ->
?dot: bool ->
?init_graph:bool ->
?out_gr:bool ->
?header:string ->
graph_file:string ->
string ->
Rewrite_history.t ->
unit
val error:
?main_feat: string ->
?dot: bool ->
?init_graph:bool ->
?header:string ->
string ->
string ->
Instance.t option ->
unit
end
module Gr_stat: sig
type t
......
......@@ -34,7 +34,7 @@ let set_timeout t = Timeout.timeout := t
IFDEF DEP2PICT THEN
let build_doc file dir grs_ast grs =
Html.proceed ~dep:true file dir grs_ast;
Html_doc.build ~dep:true file dir grs_ast;
(* draw pattern graphs for all rules and all filters *)
let fct module_ rule_ =
......@@ -45,7 +45,7 @@ let build_doc file dir grs_ast grs =
Grs.filter_iter fct grs
ELSE
let build_doc file dir grs_ast grs =
Html.proceed ~dep:false file dir grs_ast
Html_doc.build ~dep:false file dir grs_ast
END
let load_grs ?doc_output_dir file =
......@@ -155,7 +155,7 @@ let write_html
rew_hist
output_base =
ignore (
Rewrite_history.save_html
Html_rh.build
?main_feat
?dot
~out_gr
......@@ -174,7 +174,7 @@ let error_html
?init
output_base =
ignore (
Rewrite_history.error_html
Html_rh.error
?main_feat
?dot
~init_graph: (not no_init)
......@@ -191,7 +191,7 @@ let make_index ~title ~grs_file ~html ~grs ~seq ~input_dir ~output_dir ~base_nam
) init base_names in
Corpus_stat.save_html title grs_file input_dir output_dir corpus_stat
let html_sentences = Html.html_sentences
let html_sentences = Html_sentences.build
let get_css_file = Filename.concat DATA_DIR "style.css"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment