Commit cc867c57 authored by gerd's avatar gerd

Change: The XML tree is now encoded as UTF-8 strings.

	Improvement: Pages that are not included in the hierarchy
are skipped (no longer Not_found)


git-svn-id: https://godirepo.camlcity.org/svn/app-presentation/trunk@4 50e5f3cf-a9f2-0310-83d8-d11ec64cb5ab
parent 96d2f586
(* $Id: main.ml,v 1.2 2001/04/26 20:47:47 gerd Exp $
(* $Id: main.ml,v 1.3 2002/02/08 14:47:27 gerd Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -26,7 +26,7 @@ let convert_to_html filename no_gifs remove_prefix =
let document =
parse_document_entity
~id_index: idx
default_config
{ default_config with encoding = `Enc_utf8 }
(from_file filename)
To_html.tag_map
in
......@@ -64,7 +64,7 @@ let main() =
exit 1
| Some s -> s
in
run (convert_to_html fn !no_gifs) !remove
(* run *) (convert_to_html fn !no_gifs) !remove
;;
main();;
......@@ -73,6 +73,11 @@ main();;
* History:
*
* $Log: main.ml,v $
* Revision 1.3 2002/02/08 14:47:27 gerd
* Change: The XML tree is now encoded as UTF-8 strings.
* Improvement: Pages that are not included in the hierarchy
* are skipped (no longer Not_found)
*
* Revision 1.2 2001/04/26 20:47:47 gerd
* New elements: c, picture, nameref, numref
*
......
(* $Id: to_html.ml,v 1.3 2001/07/14 16:27:07 gerd Exp $
(* $Id: to_html.ml,v 1.4 2002/02/08 14:47:27 gerd Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -15,17 +15,24 @@ let map'n'concat f l =
let escape_html_re = (Pcre.regexp "\\<|\\>|\\&|\\\"");;
let escape_html s =
Pcre.substitute
~rex:escape_html_re
~subst:
(fun s ->
match s with
"<" -> "&lt;"
| ">" -> "&gt;"
| "&" -> "&amp;"
| "\"" -> "&quot;"
| _ -> assert false)
s
let s' =
Pcre.substitute
~rex:escape_html_re
~subst:
(fun s ->
match s with
"<" -> "&lt;"
| ">" -> "&gt;"
| "&" -> "&amp;"
| "\"" -> "&quot;"
| _ -> assert false)
s
in
Netconversion.recode_string
~in_enc:`Enc_utf8
~out_enc:`Enc_usascii
~subst:(fun k -> "&#" ^ string_of_int k ^ ";")
s'
;;
......@@ -558,6 +565,8 @@ class plevel =
;;
exception Skip_page
class page =
object (self)
inherit shared
......@@ -565,119 +574,127 @@ class page =
val mutable this_page = (-1)
method to_html store idx =
(* output header *)
let title =
match self # node # attribute "title" with
Value s -> s
| _ -> assert false
in
let id =
match self # node # attribute "id" with
Value s -> s
| Implied_value -> "#IMPLIED"
| _ -> assert false
in
(* process main content: *)
let main =
map'n'concat
(fun n -> n # extension # to_html store idx)
(self # node # sub_nodes) in
try
(* output header *)
let title =
match self # node # attribute "title" with
Value s -> s
| _ -> assert false
in
let id =
match self # node # attribute "id" with
Value s -> s
| Implied_value -> "#IMPLIED"
| _ -> assert false
in
(* process main content: *)
let main =
map'n'concat
(fun n -> n # extension # to_html store idx)
(self # node # sub_nodes) in
(* now process footnotes *)
let footer() = store # print_footnotes() in
let rec find_page_in_hier parent h =
if h.pageid = id then
parent
else begin
let rec find_in_list children =
match children with
[] -> raise Not_found
| x::l' ->
try find_page_in_hier h x
with
Not_found -> find_in_list l'
in
find_in_list h.children
end
in
let hierarchy = store # hierarchy in
let top_url = store # instantiate_layout "navigator.topurl" [] in
let top_title = store # instantiate_layout "navigator.toptitle" [] in
let hier_parent =
find_page_in_hier
{ pageid = "#TOP";
pagelink = top_url;
title = top_title;
children = [ hierarchy ];
related = [];
}
hierarchy
in
let this_page =
try
List.find (fun p -> p.pageid = id) hier_parent.children
with
Not_found -> assert false
in
let sublevels l =
map'n'concat
(fun h ->
store # instantiate_layout "navigator.child"
[ "LEVELTITLE", lazy (escape_html h.title);
"LEVELURL", lazy (escape_html (store # url h.pagelink));
])
l
in
let levels () =
map'n'concat
(fun h ->
let lname = if h.pageid = id
then "navigator.current"
else "navigator.level"
in
store # instantiate_layout lname
[ "LEVELTITLE", lazy (escape_html h.title);
"LEVELURL", lazy (escape_html (store # url h.pagelink));
"SUBLEVELS", lazy (sublevels h.children );
])
hier_parent.children
in
let footer() = store # print_footnotes() in
let rec find_page_in_hier parent h =
if h.pageid = id then
parent
else begin
let rec find_in_list children =
match children with
[] -> raise Not_found
| x::l' ->
try find_page_in_hier h x
with
Not_found -> find_in_list l'
in
find_in_list h.children
end
in
let hierarchy = store # hierarchy in
let top_url = store # instantiate_layout "navigator.topurl" [] in
let top_title = store # instantiate_layout "navigator.toptitle" [] in
let hier_parent =
try
find_page_in_hier
{ pageid = "#TOP";
pagelink = top_url;
title = top_title;
children = [ hierarchy ];
related = [];
}
hierarchy
with
Not_found ->
prerr_endline("Warning: Page does not occur in hierarchy: " ^ id);
raise Skip_page
in
let related() =
if this_page.related <> [] then begin
let link() =
map'n'concat
(fun (text,href) ->
store # instantiate_layout "related.link"
[ "TEXT", lazy text;
"HREF", lazy (escape_html (store # url href));
])
this_page.related in
store # instantiate_layout "related"
[ "LINK", lazy (link());
let this_page =
try
List.find (fun p -> p.pageid = id) hier_parent.children
with
Not_found -> assert false
in
let sublevels l =
map'n'concat
(fun h ->
store # instantiate_layout "navigator.child"
[ "LEVELTITLE", lazy (escape_html h.title);
"LEVELURL", lazy (escape_html (store # url h.pagelink));
])
l
in
let levels () =
map'n'concat
(fun h ->
let lname = if h.pageid = id
then "navigator.current"
else "navigator.level"
in
store # instantiate_layout lname
[ "LEVELTITLE", lazy (escape_html h.title);
"LEVELURL", lazy (escape_html (store # url h.pagelink));
"SUBLEVELS", lazy (sublevels h.children );
])
hier_parent.children
in
let related() =
if this_page.related <> [] then begin
let link() =
map'n'concat
(fun (text,href) ->
store # instantiate_layout "related.link"
[ "TEXT", lazy text;
"HREF", lazy (escape_html (store # url href));
])
this_page.related in
store # instantiate_layout "related"
[ "LINK", lazy (link());
]
end else ""
in
let page_text =
store # instantiate_layout "page"
[ "TITLE", lazy (escape_html title);
"UPURL", lazy (escape_html (store # url hier_parent.pagelink));
"UPTITLE", lazy (escape_html hier_parent.title);
"LEVEL", lazy (levels());
"RELATED", lazy (related());
"FOOTER", lazy (footer());
"CHILDREN", lazy main;
]
end else ""
in
let page_text =
store # instantiate_layout "page"
[ "TITLE", lazy (escape_html title);
"UPURL", lazy (escape_html (store # url hier_parent.pagelink));
"UPTITLE", lazy (escape_html hier_parent.title);
"LEVEL", lazy (levels());
"RELATED", lazy (related());
"FOOTER", lazy (footer());
"CHILDREN", lazy main;
]
in
page_text
in
page_text
with
Skip_page -> ""
method toc_title_of_object =
let title =
......@@ -1048,6 +1065,11 @@ let tag_map =
* History:
*
* $Log: to_html.ml,v $
* Revision 1.4 2002/02/08 14:47:27 gerd
* Change: The XML tree is now encoded as UTF-8 strings.
* Improvement: Pages that are not included in the hierarchy
* are skipped (no longer Not_found)
*
* Revision 1.3 2001/07/14 16:27:07 gerd
* Fix: <c> tag is now HTML-escaped in the right way.
*
......
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