add styling support
This commit is contained in:
parent
274b07e224
commit
d03bb5a180
3 changed files with 12 additions and 2 deletions
4
doc/txt/txt.css
Normal file
4
doc/txt/txt.css
Normal file
|
@ -0,0 +1,4 @@
|
|||
h3 {
|
||||
border-bottom: 1px solid #aaa;
|
||||
background-color: #eee;
|
||||
}
|
308
doc/txt/txt.ml
Normal file
308
doc/txt/txt.ml
Normal file
|
@ -0,0 +1,308 @@
|
|||
let dent = 4
|
||||
|
||||
type doc = item list
|
||||
and item =
|
||||
| Verb of string * string
|
||||
| Par of string
|
||||
| Ulist of doc list
|
||||
| Olist of doc list
|
||||
| Title of int * int * string
|
||||
|
||||
let (|>) x f = f x
|
||||
|
||||
let isspace = String.contains " \n\t"
|
||||
|
||||
module String = struct
|
||||
include String
|
||||
|
||||
let suff s n =
|
||||
let l = String.length s in
|
||||
if n >= l then "" else
|
||||
String.sub s n (l-n)
|
||||
|
||||
let haspref p s =
|
||||
let lp = String.length p in
|
||||
String.length s >= lp &&
|
||||
p = String.sub s 0 lp
|
||||
|
||||
let trim s =
|
||||
let l = String.length s in
|
||||
let i = ref 0 and j = ref (l-1) in
|
||||
while !i<l && isspace s.[!i]
|
||||
do incr i done;
|
||||
while !j>=0 && isspace s.[!j]
|
||||
do decr j done;
|
||||
if !j = -1 then s else sub s !i (!j- !i+1)
|
||||
end
|
||||
|
||||
let warn = Printf.eprintf
|
||||
|
||||
let getdent s =
|
||||
let rec f n =
|
||||
if n >= String.length s then 0 else
|
||||
if s.[n] = ' ' then f (n+1) else
|
||||
if s.[n] = '\t' then f (n+8) else
|
||||
n/dent in
|
||||
f 0
|
||||
|
||||
let dedent s i =
|
||||
let rec f i j =
|
||||
if i <= 0 then (-i, j) else
|
||||
if j >= String.length s then (0, j) else
|
||||
if s.[j] = ' ' then f (i-1) (j+1) else
|
||||
if s.[j] = '\t' then f (i-8) (j+1) else
|
||||
(0, j) in
|
||||
let (p, j) = f (i*dent) 0 in
|
||||
String.make p ' ' ^ String.suff s j
|
||||
|
||||
let rec getlines acc n =
|
||||
match try Some (read_line ()) with End_of_file -> None with
|
||||
| Some s ->
|
||||
getlines ((n, getdent s, s) :: acc) (n+1)
|
||||
| None -> List.rev acc
|
||||
|
||||
let matchs skip fin s =
|
||||
let rec f n =
|
||||
if n >= String.length s then 0 else
|
||||
if s.[n] = fin then (n+1) else
|
||||
if String.contains skip s.[n] then f (n+1) else
|
||||
0 in
|
||||
f 0
|
||||
|
||||
let endnum = matchs " 0123456789" '.'
|
||||
let endbul = matchs " " '*'
|
||||
let skipnum s = String.suff s (endnum s)
|
||||
let skipbul s = String.suff s (endbul s)
|
||||
|
||||
let gettitles lines =
|
||||
let titles = Hashtbl.create 100 in
|
||||
let insert lvl n t =
|
||||
let t = String.trim (skipnum (String.suff t 2)) in
|
||||
if Hashtbl.mem titles t then
|
||||
warn "line %d: title has multiple definitions\n" n;
|
||||
Hashtbl.add titles t (lvl, n) in
|
||||
lines |> List.iter begin fun (n, lvl, t) ->
|
||||
if lvl <> 0 then () else
|
||||
if String.haspref "- " t then insert 0 n t else
|
||||
if String.haspref "~ " t then insert 1 n t else
|
||||
()
|
||||
end;
|
||||
titles
|
||||
|
||||
let top lines =
|
||||
match !lines with
|
||||
| [] -> None
|
||||
| l :: _ -> Some l
|
||||
|
||||
let pop lines =
|
||||
lines := List.tl !lines
|
||||
let push lines l =
|
||||
lines := l :: !lines
|
||||
|
||||
let isolist l = endnum l <> 0
|
||||
let isulist l = endbul l <> 0
|
||||
|
||||
let getverb lines idnt =
|
||||
let rec f ls =
|
||||
match top lines with
|
||||
| Some (n, i, l)
|
||||
when i >= idnt
|
||||
|| dedent l (i+1) = "" ->
|
||||
pop lines;
|
||||
f (dedent l idnt :: ls)
|
||||
| _ ->
|
||||
let ls =
|
||||
if List.hd ls = ""
|
||||
then List.tl ls
|
||||
else ls in
|
||||
List.rev ls |>
|
||||
String.concat "\n" in
|
||||
f []
|
||||
|
||||
let getpar lines idnt =
|
||||
let rec f ls =
|
||||
match top lines with
|
||||
| Some (n, i, l)
|
||||
when i = idnt
|
||||
&& l <> ""
|
||||
&& not (isolist l)
|
||||
&& not (isulist l) ->
|
||||
pop lines;
|
||||
f (l :: ls)
|
||||
| _ ->
|
||||
List.rev ls |>
|
||||
String.concat "\n" in
|
||||
f []
|
||||
|
||||
let mergedoc =
|
||||
let rec aggreg f = function
|
||||
| (i :: is) as is'->
|
||||
begin match f i with
|
||||
| Some l ->
|
||||
let l', is = aggreg f is in
|
||||
List.append l l', is
|
||||
| None -> [], is'
|
||||
end
|
||||
| is -> [], is in
|
||||
let ul = function Ulist l -> Some l | _ -> None in
|
||||
let ol = function Olist l -> Some l | _ -> None in
|
||||
let rec f d = match d with
|
||||
| Ulist _ :: _ ->
|
||||
let l, d = aggreg ul d in
|
||||
Ulist l :: f d
|
||||
| Olist _ :: _ ->
|
||||
let l, d = aggreg ol d in
|
||||
Olist l :: f d
|
||||
| i :: d -> i :: f d
|
||||
| [] -> [] in
|
||||
f
|
||||
|
||||
let rec getdoc lines si acc =
|
||||
match top lines with
|
||||
| Some (n, i, l) ->
|
||||
if i = si && isolist l then begin (* Olist item *)
|
||||
pop lines;
|
||||
push lines (n, i+1, skipnum l);
|
||||
let li = getdoc lines (si+1) [] in
|
||||
getdoc lines si (Olist [li] :: acc);
|
||||
end else
|
||||
if i = si && isulist l then begin (* Ulist item *)
|
||||
pop lines;
|
||||
push lines (n, i+1, skipbul l);
|
||||
let li = getdoc lines (si+1) [] in
|
||||
getdoc lines si (Ulist [li] :: acc);
|
||||
end else
|
||||
if i > si then begin (* Verb item *)
|
||||
let ty =
|
||||
let l = dedent l i in
|
||||
if l.[0] <> '[' then "" else begin
|
||||
pop lines;
|
||||
l
|
||||
end in
|
||||
let verb = getverb lines (si+1) in
|
||||
getdoc lines si (Verb (ty, verb) :: acc);
|
||||
end else
|
||||
if si = 0 && String.haspref "~ " l
|
||||
|| si = 0 && String.haspref "- " l then begin (* Titles *)
|
||||
pop lines;
|
||||
let lvl = if l.[0] = '-' then 0 else 1 in
|
||||
let tit = String.suff l 2 in
|
||||
getdoc lines si (Title (lvl, n, tit) :: acc);
|
||||
end else
|
||||
if String.haspref "---" l
|
||||
|| String.haspref "~~~" l
|
||||
|| l = "" then begin (* Decorations *)
|
||||
pop lines;
|
||||
getdoc lines si acc;
|
||||
end else
|
||||
if i = si then begin (* Par item *)
|
||||
let par = getpar lines si in
|
||||
getdoc lines si (Par par :: acc);
|
||||
end else
|
||||
List.rev acc |> mergedoc
|
||||
| None -> List.rev acc |> mergedoc
|
||||
|
||||
type printer =
|
||||
{ pchar: char -> unit
|
||||
; plink: string -> unit
|
||||
; pcode: string -> unit
|
||||
}
|
||||
|
||||
let print pp s =
|
||||
let l = String.length s in
|
||||
let rec getlink j spc =
|
||||
if j >= l || s.[j] = '>' then j+1, "" else
|
||||
if isspace s.[j] then
|
||||
getlink (j+1) true
|
||||
else
|
||||
let j', t = getlink (j+1) false in
|
||||
if spc then
|
||||
j', Printf.sprintf " %c%s" s.[j] t
|
||||
else
|
||||
j', Printf.sprintf "%c%s" s.[j] t in
|
||||
let getlink j =
|
||||
let j', s = getlink j false in
|
||||
j', String.trim s in
|
||||
let rec getdlim j d =
|
||||
if j >= l || s.[j] = d then j+1, "" else
|
||||
let j', t = getdlim (j+1) d in
|
||||
j', Printf.sprintf "%c%s" s.[j] t in
|
||||
let rec f i =
|
||||
if i >= l then () else
|
||||
match s.[i] with
|
||||
| '<' when i < l-1 && s.[i+1] = '@' ->
|
||||
let i, t = getlink (i+2) in
|
||||
pp.plink t;
|
||||
f i
|
||||
| '`' ->
|
||||
let i, t = getdlim (i+1) '`' in
|
||||
pp.pcode t;
|
||||
f i
|
||||
| c ->
|
||||
pp.pchar c;
|
||||
f (i+1)
|
||||
in f 0
|
||||
|
||||
let rec dochtml titles d =
|
||||
let open Printf in
|
||||
let pchar = function
|
||||
| '<' -> printf "<"
|
||||
| '>' -> printf ">"
|
||||
| '&' -> printf "&"
|
||||
| c -> printf "%c" c in
|
||||
let escape = String.iter pchar in
|
||||
let plink l =
|
||||
try
|
||||
let (_, n) = Hashtbl.find titles l in
|
||||
printf "<a href=\"#%d\">%s</a>" n l
|
||||
with Not_found ->
|
||||
warn "warning: unresolved link '%s'\n" l;
|
||||
printf "<a href=\"#\">%s</a>" l in
|
||||
let pcode s =
|
||||
printf "<code>";
|
||||
escape s;
|
||||
printf "</code>"; in
|
||||
let pp = {pchar; plink; pcode} in
|
||||
let rec plist =
|
||||
List.iter begin fun d ->
|
||||
match d with
|
||||
| Par p :: d ->
|
||||
printf "<li>";
|
||||
print pp p;
|
||||
printf "\n";
|
||||
dochtml titles d;
|
||||
| d ->
|
||||
printf "<li>";
|
||||
dochtml titles d;
|
||||
end in
|
||||
let itemhtml = function
|
||||
| Title (0, n, t) ->
|
||||
printf "<h3><a id='%d'>" n;
|
||||
escape t;
|
||||
printf "</a></h3>\n";
|
||||
| Title (_, n, t) ->
|
||||
printf "<h4><a id='%d'>" n;
|
||||
escape t;
|
||||
printf "</a></h4>\n";
|
||||
| Olist l ->
|
||||
printf "<ol>\n";
|
||||
plist l;
|
||||
printf "</ol>\n";
|
||||
| Ulist l ->
|
||||
printf "<ul>\n";
|
||||
plist l;
|
||||
printf "</ul>\n";
|
||||
| Verb (_, v) ->
|
||||
printf "<pre>\n";
|
||||
escape v;
|
||||
printf "\n</pre>\n";
|
||||
| Par p ->
|
||||
printf "<p>\n";
|
||||
print pp p;
|
||||
printf "\n</p>\n"; in
|
||||
List.iter itemhtml d
|
||||
|
||||
let _ =
|
||||
let lines = getlines [] 1 in
|
||||
let titles = gettitles lines in
|
||||
getdoc (ref lines) 0 [] |> dochtml titles
|
Loading…
Add table
Add a link
Reference in a new issue