shinyoukai/kosuzu
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Tidy

Browse Source 
Signed-off-by: Izuru Yakumo <yakumo.izuru@chaotic.ninja>

git-svn-id: file:///srv/svn/repo/kosuzu/trunk@52 eb64cd80-c68d-6f47-b6a3-0ada418499da
This commit is contained in:
yakumo.izuru
2023-10-21 00:34:31 +00:00
parent 1c10f38728
commit 51ac2486d4
1 changed files with 145 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
cli/html.ml
View File

@@ -13,7 +13,7 @@ let init kv =
let header = to_string "HTM-header" kv in let header = to_string "HTM-header" kv in
let footer = to_string "HTM-footer" kv in let footer = to_string "HTM-footer" kv in
let style = match to_string "HTM-style" kv with let style = match to_string "HTM-style" kv with
| Some s -> Printf.sprintf "<style>%s</style>\n" s | None -> "" in | Some s -> Printf.sprintf "<style type=\"text/css\">%s</style>\n" s | None -> "" in
{ templates = { header; footer}; style } { templates = { header; footer}; style }
let wrap conv htm text_title body = let wrap conv htm text_title body =
@@ -31,8 +31,7 @@ let wrap conv htm text_title body =
(if feed <> "" then sprintf "<a href='%s' id='feed'>feed</a>" feed else "")) (if feed <> "" then sprintf "<a href='%s' id='feed'>feed</a>" feed else ""))
in in
let footer = match htm.templates.footer with None -> "" | Some x -> replace x in let footer = match htm.templates.footer with None -> "" | Some x -> replace x in
Printf.sprintf "<!DOCTYPE HTML PUBLIC \"//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n<html>\n<head>\n<link rel=\"icon\" href=\"/favicon.png\">\n<title>%s%s</title>\n%s\n%s\ Printf.sprintf "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n<html>\n<head>\n<link rel=\"icon\" href=\"/favicon.png\">\n<title>%s%s</title>\n%s\n%s\n<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">\n<meta http-equiv=\"Content-type\" content=\"text/html; charset=utf-8\">\n</head>\n<body>\n%s%s%s</body>\n</html>"
<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">\n<meta http-equiv=\"Content-type\" content=\"text/html; charset=utf-8\">\n</head>\n<body>\n%s%s%s</body>\n</html>"
text_title (if site_title <> "" then (" • " ^ site_title) else "") text_title (if site_title <> "" then (" • " ^ site_title) else "")
htm.style htm.style
(if feed <> "" then Printf.sprintf "<link rel='alternate' href='%s' type='application/atom+xml'>" feed else "") (if feed <> "" then Printf.sprintf "<link rel='alternate' href='%s' type='application/atom+xml'>" feed else "")
@@ -58,7 +57,6 @@ let page htm conversion text =
let sep_append ?(sep=", ") a x = match a,x with "",_ -> x | _, "" -> a | _ -> a ^ sep ^ x in let sep_append ?(sep=", ") a x = match a,x with "",_ -> x | _, "" -> a | _ -> a ^ sep ^ x in
let opt_kv key value = if String.length value > 0 let opt_kv key value = if String.length value > 0
then "<dt>" ^ key ^ "<dd>" ^ value else "" in then "<dt>" ^ key ^ "<dd>" ^ value else "" in
(* let author acc auth = sep_append acc Person.(auth.name ^ " ") in*)
let authors = Person.Set.to_string text.authors in let authors = Person.Set.to_string text.authors in
let header = let header =
let time x = Printf.sprintf {|<span class="%s">%s</span>|} let time x = Printf.sprintf {|<span class="%s">%s</span>|}
@@ -70,14 +68,10 @@ let page htm conversion text =
String_set.fold to_linked x "" in String_set.fold to_linked x "" in
let ref_links x = let ref_links x =
let link l = HtmlConverter.uid_uri l "" in let link l = HtmlConverter.uid_uri l "" in
String_set.fold (fun r a -> sep_append a (link r)) x "" String_set.fold (fun r a -> sep_append a (link r)) x "" in
in
let references, replies = let open Conversion in let references, replies = let open Conversion in
let Rel.{ref_set; rep_set; _} = let Rel.{ref_set; rep_set; _} = try Rel.Id_map.find text.id conversion.relations with Not_found -> Rel.empty in
try Rel.Id_map.find text.id conversion.relations ref_links ref_set, ref_links rep_set in
with Not_found -> Rel.empty in
ref_links ref_set, ref_links rep_set
in
"<dl>" "<dl>"
^ opt_kv "Title:" text.title ^ opt_kv "Title:" text.title
^ opt_kv "Authors:" authors ^ opt_kv "Authors:" authors
@@ -99,11 +93,9 @@ let to_dated_links ?(limit) meta_list =
let rec reduced acc i = function let rec reduced acc i = function
| [] -> acc | [] -> acc
| h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in
List.rev @@ reduced [] 0 meta_list List.rev @@ reduced [] 0 meta_list in
in
List.fold_left List.fold_left
(fun a m -> Printf.sprintf "%s<li> %s <a href=\"%s.htm\">%s</a>" a (fun a m -> Printf.sprintf "%s<li>%s <a href=\"%s.htm\">%s</a></li>" a Logarion.(Date.(pretty_date (listing m.Text.date)))
Logarion.(Date.(pretty_date (listing m.Text.date)))
(Logarion.Text.short_id m) m.Logarion.Text.title) (Logarion.Text.short_id m) m.Logarion.Text.title)
"" meta_list "" meta_list
@@ -129,19 +121,17 @@ let fold_topics topic_map topic_roots metas =
and list_item root t = and list_item root t =
let item = let item =
if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas
then topic_link root t else String.capitalize_ascii t then topic_link root t else String.capitalize_ascii t in
in "<ul><li>" ^ item ^ sub_items root t ^ "</ul>" in
"<li>" ^ item ^ sub_items root t
in
"<h2>Topics</h2>" "<h2>Topics</h2>"
^ List.fold_left (fun a x -> a ^ list_item x x) "<ul>" (List.rev topic_roots) ^ List.fold_left (fun a x -> a ^ list_item x x) "<ul>" (List.rev topic_roots)
^ "</ul>" ^ "</ul>"
let text_item path meta = let text_item path meta =
let open Logarion in let open Logarion in
"<span>" ^ Date.(pretty_date (listing meta.Text.date)) "<p>" ^ Date.(pretty_date (listing meta.Text.date))
^ {|</span> <a href="|} ^ path ^ Text.short_id meta ^ {|.htm">|} ^ meta.Text.title ^ {|<a href="|} ^ path ^ Text.short_id meta ^ {|.htm">|} ^ meta.Text.title
^ "</a><br>" ^ "</a></p><br>"
let listing_index topic_map topic_roots path metas = let listing_index topic_map topic_roots path metas =
let rec item_group topics = let rec item_group topics =
@@ -158,15 +148,14 @@ let listing_index topic_map topic_roots path metas =
then text_item path e ^ a else a) "" metas in then text_item path e ^ a else a) "" metas in
match items with match items with
| "" -> "" | "" -> ""
| x -> {|<h2 id="|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</h2>" ^ x | x -> {|<h2 id="|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</h2>" ^ x in
in
"<h1>Texts</h1>" ^ item_group topic_roots ^ "" "<h1>Texts</h1>" ^ item_group topic_roots ^ ""
let topic_main_index conv htm topic_roots metas = let topic_main_index conv htm topic_roots metas =
wrap conv htm "Topics" wrap conv htm "Topics"
(fold_topic_roots topic_roots (fold_topic_roots topic_roots
^ "<h1>Latest</h1><ul>" ^ to_dated_links ~limit:8 metas ^ "<h1>Latest</h1><ul>" ^ to_dated_links ~limit:10 metas
^ {|</ul><a href="index.date.htm">More by date</a>|} ^ {|<p><a href="index.date.htm">More by date</a></p>|}
^ let peers = try Logarion.Store.KV.find "Peers" conv.kv with Not_found -> "" in ^ let peers = try Logarion.Store.KV.find "Peers" conv.kv with Not_found -> "" in
(if peers = "" then "" else (if peers = "" then "" else
List.fold_left (fun a s -> Printf.sprintf {|%s<li><a href="%s">%s</a>|} a s s) "<h1>Peers</h1><ul>" List.fold_left (fun a s -> Printf.sprintf {|%s<li><a href="%s">%s</a>|} a s s) "<h1>Peers</h1><ul>"
@@ -176,7 +165,6 @@ let topic_main_index conv htm topic_roots metas =
let topic_sub_index conv htm topic_map topic_root metas = let topic_sub_index conv htm topic_map topic_root metas =
wrap conv htm topic_root wrap conv htm topic_root
(fold_topics topic_map [topic_root] metas (fold_topics topic_map [topic_root] metas
(* ^ {|<a href=".atom" id="feed">|}^ String.capitalize_ascii topic_root ^{| feed </a>|}*)
^ listing_index topic_map [topic_root] "" metas) ^ listing_index topic_map [topic_root] "" metas)
let indices htm c = let indices htm c =