diff options
Diffstat (limited to 'doc/txt.ml')
| -rw-r--r-- | doc/txt.ml | 308 |
1 files changed, 0 insertions, 308 deletions
diff --git a/doc/txt.ml b/doc/txt.ml deleted file mode 100644 index a753cc3..0000000 --- a/doc/txt.ml +++ /dev/null @@ -1,308 +0,0 @@ -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 |