Skip to content

GitLab

Commit f8e5b9de authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-05-21 21:43:26 by cvscast] Bugs in print_xml and site.cd 

Original author: cvscast
Date: 2003-05-21 21:43:26+00:00
parent d3f53047
Hide whitespace changes
Inline Side-by-side
runtime/value.ml
View file @ f8e5b9de
......@@ -42,9 +42,9 @@ let rec add_buf_utf8_to_latin1 src i j =
Buffer.add_char buf (Char.chr c);
add_buf_utf8_to_latin1 src i j
let rec add_buf_latin1_to_utf8_to_latin1 src i j =
for k = i to j do
Utf8.store buf (Char.code src.[i])
let rec add_buf_latin1_to_utf8 src i j =
for k = i to j - 1 do
Utf8.store buf (Char.code src.[k])
done
let get_string_latin1 e =
......@@ -61,7 +61,7 @@ let get_string_latin1 e =
let get_string_utf8 e =
let rec aux = function
| Pair (Char x,y) -> Utf8.store buf (Chars.to_int x); aux y
| String_latin1 (i,j,src,y) -> add_buf_latin1_to_utf8_to_latin1 src i j; aux y
| String_latin1 (i,j,src,y) -> add_buf_latin1_to_utf8 src i j; aux y
| String_utf8 (i,j,src,y) -> Utf8.copy buf src i j; aux y
| q -> q in
let q = aux e in
......
web/site.cd
View file @ f8e5b9de
......@@ -70,7 +70,7 @@ let fun load_include (String -> [Any*])
(* let _ = print [ 'Loading ' !name '... \n' ] in *)
xtransform [ (load_xml name) ] with
| <include file=(s & String)>[] -> load_include s
| <include-verbatim file=(s & String)>[] -> load_file s;;
| <include-verbatim file=(s & String)>[] -> let [] = print s in load_file s;;
(* Highlighting text between {{...}} *)
......@@ -167,8 +167,9 @@ let fun link_to (Page -> Xa)
(* Main transformation function *)
(* returns the last page of the descendance *)
let fun gen_page (prev : Page|[], page : Page, next : Page|[],
path : Path, sitemap : Tree) : [] =
path : Path, sitemap : Tree) : (Page|[]) =
match page with
<page name=name>[
<title>title <banner>banner | <title>(title & banner); items ] ->
......@@ -251,7 +252,7 @@ match page with
in
let npath = path @ [ { url = url_of_name name; title = title } ] in
let subpages = transform items with p & Page -> [ p ] in
let next = gen_page_seq (page, subpages, next, npath, sitemap) in
let (next,last) = gen_page_seq (page, subpages, next, npath, sitemap) in
let next = match next with [] -> [] | p -> [' Next : ' (link_to p)] in
let prev = match prev with [] -> [] | p -> [' Prev : ' (link_to p)] in
let html : Xhtml =
......@@ -276,23 +277,27 @@ match page with
[ '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
!(patch_css (print_xml html)) ] in
dump_to_file ("www/" @ name @ (if php then ".html.php" else ".html")) txt;;
let fn = "www/" @ name @ (if php then ".html.php" else ".html") in
let [] = dump_to_file fn txt in
last;;
let fun gen_page_seq
(prev : Page|[], pages : [Page*], next : Page|[],
path : Path, sitemap : Tree) : Page|[] =
path : Path, sitemap : Tree) : (Page|[], Page|[]) =
match pages with
| [ p1 p2 ; _ ] & [ _; rest ] ->
let [] = gen_page (prev,p1,p2, path, sitemap) in
let _ = gen_page_seq (p1, rest, next, path, sitemap) in p1
let last = gen_page (prev,p1,p2, path, sitemap) in
let (_,last) = gen_page_seq (last, rest, next, path, sitemap) in
(p1,last)
| [ p ] ->
let [] = gen_page (prev,p,next, path, sitemap) in p
| [] -> next;;
let last = gen_page (prev,p,next, path, sitemap) in (p,last)
| [] -> (next,prev);;
(* Entry point *)
match load_include input with
| [ Page & p ] -> gen_page ([],p,[], [], compute_sitemap p)
| [ Page & p ] -> let _ = gen_page ([],p,[], [], compute_sitemap p) in []
| _ -> raise ("Invalid input document " @ input);;
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