Source file Xml_forester.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
open Pure_html

let reserved_prefix = "fr"
let forester_xmlns = "http://www.jonmsterling.com/jms-005P.xml"


let null = HTML.null
let null_ = HTML.null_

let optional kont opt =
  match opt with
  | Some x -> kont x
  | None -> null []

let optional_ kont opt =
  match opt with
  | Some x -> kont x
  | None -> null_


let register_ns tag attrs =
  let f_xmlns = string_attr ("xmlns:" ^ reserved_prefix) "%s" forester_xmlns in
  tag (f_xmlns :: attrs)

let add_ns name = Format.sprintf "%s:%s" reserved_prefix name


let f_std_tag name = std_tag @@ add_ns name
let f_text_tag name = text_tag @@ add_ns name

let f_void_tag name attrs = std_tag (add_ns name) attrs []

let info = f_std_tag "info"

let tree = f_std_tag "tree"
let numbered = bool_attr "numbered"
let toc = bool_attr "toc"
let expanded = bool_attr "expanded"
let show_heading = bool_attr "show-heading"
let show_metadata = bool_attr "show-metadata"
let root = bool_attr "root"

let frontmatter = f_std_tag "frontmatter"
let mainmatter = f_std_tag "mainmatter"
let backmatter = f_std_tag "backmatter"

let query_tree = f_std_tag "query-tree"

let anchor attrs = f_text_tag "anchor" attrs
let taxon attrs = f_text_tag "taxon" attrs
let addr attrs = f_text_tag "addr" attrs
let route attrs = f_text_tag "route" attrs
let source_path attrs = f_text_tag "source-path" attrs
let href fmt = uri_attr "href" fmt
let date = f_std_tag "date"
let last_changed = f_std_tag "last-changed"
let year attrs = f_text_tag "year" attrs
let month attrs = f_text_tag "month" attrs
let day attrs = f_text_tag "day" attrs
let authors = f_std_tag "authors"
let author = f_std_tag "author"
let contributor = f_std_tag "contributor"
let title = f_std_tag "title"

let link = f_std_tag "link"
let type_ fmt = string_attr "type" fmt
let addr_ fmt = string_attr "addr" fmt
let text_ fmt = string_attr "text" fmt

let number attrs = f_text_tag "number" attrs
let parent attrs = f_text_tag "parent" attrs

let meta = f_std_tag "meta"
let name fmt = string_attr "name" fmt

let tex attrs = f_text_tag ~raw:true "tex" attrs
let display fmt = string_attr "display" fmt

let title_ fmt = string_attr "title" fmt

let prim p =
  let name =
    match p with
    | `P -> "p"
    | `Ul -> "ul"
    | `Ol -> "ol"
    | `Li -> "li"
    | `Em -> "em"
    | `Strong -> "strong"
    | `Code -> "code"
    | `Blockquote -> "blockquote"
    | `Pre -> "pre"
    | `Figure -> "figure"
    | `Figcaption -> "figcaption"
  in
  f_std_tag name

let ref = f_void_tag "ref"

let taxon_ fmt = string_attr "taxon" fmt
let number_ fmt = string_attr "number" fmt

let img = f_void_tag "img"
let src fmt = uri_attr "src" fmt

let embedded_tex = f_std_tag "embedded-tex"
let embedded_tex_preamble attrs = f_text_tag ~raw:true "embedded-tex-preamble" attrs
let embedded_tex_body attrs = f_text_tag ~raw:true "embedded-tex-body" attrs
let hash fmt = string_attr "hash" fmt