software-archive/logarion-2021
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

HTML5 format by Novaburst

Browse Source
This commit is contained in:
orbifx 2021-06-23 21:03:10 +01:00
parent 2f3d88a0c5
commit 673190ab45
1 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
cli/html.ml
View File

@ -1,13 +1,19 @@
let wrap ?(keywords="") (title:string) (subtitle:string) body = let wrap (title:string) (subtitle:string) body =
{|<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title>|} {|<!DOCTYPE HTML>|}
^ {|<html><head><title>|}
^ subtitle ^ " | " ^ title ^ subtitle ^ " | " ^ title
^ {|</title><link rel="stylesheet" href="main.css" media/><link rel="alternate" href="feed.atom" type="application/atom+xml"/><meta charset="utf-8"/> <meta name="keywords" content="|} ^ {|</title><link rel="stylesheet" href="main.css">|}
^ keywords ^ {|"></head><body><header><a href=".">|} ^ title ^ {|<link rel="alternate" href="feed.atom" type="application/atom+xml">|}
^ {|<meta charset="utf-8"/>|}
^ {|<meta name="viewport" content="width=device-width, initial-scale=1.0">|}
^ {|</head><body><header><a href=".">|} ^ title
^ {|</a> <nav><a href="feed.atom" id="feed">feed</a></nav></header>|} ^ body ^ {|</a> <nav><a href="feed.atom" id="feed">feed</a></nav></header>|} ^ body
^ "</body></html>" ^ "</body></html>"
let topic_link root topic = let topic_link root topic =
{|<a href="index.|} ^ root ^ {|.htm#|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</a>" let replaced_space = String.map (function ' '->'+' | x->x) in
{|<a href="index.|} ^ root ^ {|.htm#|} ^ replaced_space topic ^ {|">|}
^ String.capitalize_ascii topic ^ "</a>"
let page archive_title text = let page archive_title text =
let open Logarion in let open Logarion in
@ -34,7 +40,7 @@ let page archive_title text =
^ opt_kv "Keywords: " keywords ^ opt_kv "Keywords: " keywords
^ opt_kv "Id: " (Id.to_string text.uuid) ^ opt_kv "Id: " (Id.to_string text.uuid)
^ {|</dl></header><pre style="white-space:pre-wrap">|} in ^ {|</dl></header><pre style="white-space:pre-wrap">|} in
wrap ~keywords archive_title text.title ((T.of_string text.body header) ^ "</pre></article>") wrap archive_title text.title ((T.of_string text.body header) ^ "</pre></article>")
let to_dated_links ?(limit) meta_list = let to_dated_links ?(limit) meta_list =
let meta_list = match limit with let meta_list = match limit with
@ -48,7 +54,7 @@ let to_dated_links ?(limit) meta_list =
List.fold_left List.fold_left
(fun a m -> (fun a m ->
a ^ Logarion.(Date.(pretty_date (listing m.Text.date)) ^ " ") a ^ Logarion.(Date.(pretty_date (listing m.Text.date)) ^ " ")
^ {|<a href="|} ^ Logarion.Text.alias m ^ {|.htm">|} ^ m.Logarion.Text.title ^ "</a><br/>") ^ {|<a href="|} ^ Logarion.Text.alias m ^ {|.htm">|} ^ m.Logarion.Text.title ^ "</a><br>")
"" meta_list "" meta_list
let date_index ?(limit) title meta_list = let date_index ?(limit) title meta_list =
@ -85,7 +91,7 @@ let text_item path meta =
let open Logarion in let open Logarion in
"<time>" ^ Date.(pretty_date (listing meta.Text.date)) "<time>" ^ Date.(pretty_date (listing meta.Text.date))
^ {|</time> <a href="|} ^ path ^ Text.alias meta ^ {|.htm">|} ^ meta.Text.title ^ {|</time> <a href="|} ^ path ^ Text.alias meta ^ {|.htm">|} ^ meta.Text.title
^ "</a><br/>" ^ "</a><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 =
@ -109,7 +115,7 @@ let listing_index topic_map topic_roots path metas =
let topic_main_index title topic_roots metas = let topic_main_index title topic_roots metas =
wrap title "Topics" wrap title "Topics"
(fold_topic_roots topic_roots (fold_topic_roots topic_roots
^ "<nav><h1>Latest</h1>" ^ to_dated_links ~limit:5 metas ^ "<nav><h1>Latest</h1>" ^ to_dated_links ~limit:10 metas
^ {|<a href="index.date.htm">More by date</a></nav>|} ) ^ {|<a href="index.date.htm">More by date</a></nav>|} )
let topic_sub_index title topic_map topic_root metas = let topic_sub_index title topic_map topic_root metas =