open Tdl
let string_of_in_channel ic =
let len = 1024 in
let s = String.create len in
let buf = Buffer.create len in
let rec iter () =
try
let n = input ic s 0 len in
if n = 0 then
()
else
(
Buffer.add_substring buf s 0 n;
iter ()
)
with
End_of_file -> ()
in
iter ();
Buffer.contents buf
let default_page_type =
"<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>"^
"<!DOCTYPE html \n"^
"PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" ^
"\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"
let p = Printf.fprintf
let page oc style title f_body arg =
p oc "%s"
(default_page_type^
"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">\n"^
"<link rel=\"stylesheet\" type=\"text/css\" href=\""^style^"\">\n"^
"<title>"^title^"</title></head>\n"^
"<body>"
);
f_body oc arg;
p oc "</body>\n</html>"
let ic = ref stdin
let oc = ref stdout
let gen_page = ref false
let css_style = ref "style.css"
let gen_css = ref None
let options = [
"-i", Arg.String (fun s -> ic := open_in s), "<file>\tread from <file> instead of standard input";
"-o", Arg.String (fun s -> oc := open_out s), "<file>\toutput to <file> instead of standard output";
"--page", Arg.Set gen_page, " generate a whole page instead of just a piece of html";
"--css", Arg.Set_string css_style, "<url>\tcss style sheet to use, when generating a whole page (default: "^ !css_style ^")";
"--gen-css", Arg.String (fun s -> gen_css := Some s),
"<file>\tgenerate a default CSS style sheet in given file";
]
let print_item oc i =
p oc "<div class=\"TDL_item\"><span class=\"TDL_item_title\">";
p oc "%s%s [<span class=\"TDL_item_state\">%s</span>]"
i.item_title
""
(Tdl.string_of_state i.item_state);
p oc "</span>";
(
match i.item_desc with
None -> ()
| Some s -> p oc "<div class=\"TDL_item_desc\">%s</div>" s
);
p oc "</div>\n"
let rec print_group oc g =
p oc "<div class=\"TDL_group_title\">%s</div>" g.group_title;
p oc "<div class=\"TDL_group_body\">";
List.iter (print_item oc) g.group_items;
List.iter (print_group oc) g.group_groups;
p oc "</div>"
let print oc g =
if !gen_page then
page oc !css_style g.group_title print_group g
else
print_group oc g
let default_style_sheet =
"\ndiv.TDL_group_title { font-weight: bold ; padding-left: 0.5em; }\ndiv.TDL_group_body {\n margin-left: 1em ; border-style: solid; border-width: 0 0 0 1px; border-color: blue;\n padding-bottom: 0.5em;\n }\ndiv.TDL_item_desc { font-size: smaller ; margin-left: 0.5em; }\nspan.TDL_item_state { font-style: italic ; }\ndiv.TDL_item { padding-left: 0.5em; }\n"
;;
let main () =
Arg.parse options
(fun _ -> ())
(Printf.sprintf "Usage: %s [options]\nwhere options are:" Sys.argv.(0));
let s = string_of_in_channel !ic in
let g = Tdl.group_of_string s in
print !oc g;
close_in !ic;
close_out !oc;
match !gen_css with
None -> ()
| Some f ->
let oc = open_out f in
output_string oc default_style_sheet;
close_out oc
;;
let _ =
try main ()
with Sys_error s | Failure s ->
prerr_endline s;
exit 1