jon.recoil.org
this repo has no description
1(** Raw latex primitives:
2 - macro definitions
3 - env defitions
4 - text escaping *)
5
6type pr = Format.formatter -> unit
7
8type 'a with_options = ?options:pr list -> 'a
9
10type ('a, 'b) tr = 'a Fmt.t -> 'b Fmt.t
11
12type 'a t = ('a, 'a) tr
13
14module Escape = struct
15 let text ~code_hyphenation =
16 let b = Buffer.create 17 in
17 fun s ->
18 for i = 0 to String.length s - 1 do
19 match s.[i] with
20 | '{' -> Buffer.add_string b "\\{"
21 | '}' -> Buffer.add_string b "\\}"
22 | '\\' -> Buffer.add_string b "\\textbackslash{}"
23 | '%' -> Buffer.add_string b "\\%"
24 | '~' -> Buffer.add_string b "\\textasciitilde{}"
25 | '^' -> Buffer.add_string b "\\textasciicircum{}"
26 | '_' ->
27 if code_hyphenation then Buffer.add_string b {|\_\allowbreak{}|}
28 else Buffer.add_string b {|\_|}
29 | '.' when code_hyphenation -> Buffer.add_string b {|.\allowbreak{}|}
30 | ';' when code_hyphenation -> Buffer.add_string b {|;\allowbreak{}|}
31 | ',' when code_hyphenation -> Buffer.add_string b {|,\allowbreak{}|}
32 | '&' -> Buffer.add_string b "\\&"
33 | '#' -> Buffer.add_string b "\\#"
34 | '$' -> Buffer.add_string b "\\$"
35 | c -> Buffer.add_char b c
36 done;
37 let s = Buffer.contents b in
38 Buffer.reset b;
39 s
40
41 let pp ~code_hyphenation ppf x =
42 Format.pp_print_string ppf (text ~code_hyphenation x)
43
44 let ref ppf s =
45 for i = 0 to String.length s - 1 do
46 match s.[i] with
47 | '~' -> Fmt.pf ppf "+t+"
48 | '&' -> Fmt.pf ppf "+a+"
49 | '^' -> Fmt.pf ppf "+c+"
50 | '%' -> Fmt.pf ppf "+p+"
51 | '{' -> Fmt.pf ppf "+ob+"
52 | '}' -> Fmt.pf ppf "+cb+"
53 | '+' -> Fmt.pf ppf "+++"
54 | c -> Fmt.pf ppf "%c" c
55 done
56end
57
58let option ppf pp = Fmt.pf ppf "[%t]" pp
59
60let create name ?(options = []) pp ppf content =
61 Fmt.pf ppf {|\%s%a{%a}|} name (Fmt.list option) options pp content
62
63let math name ppf = Fmt.pf ppf {|$\%s$|} name
64
65let create2 name ?(options = []) pp_x pp_y ppf x y =
66 Fmt.pf ppf {|\%s%a{%a}{%a}|} name (Fmt.list option) options pp_x x pp_y y
67
68let bind pp x ppf = pp ppf x
69
70let label ppf = create "label" Escape.ref ppf
71
72let mbegin ?options = create "begin" ?options Fmt.string
73
74let mend = create "end" Fmt.string
75
76let code_fragment pp = create "ocamlcodefragment" pp
77
78let break ppf level =
79 let pre : _ format6 =
80 match level with
81 | Types.Aesthetic -> "%%"
82 | Line -> {|\\|}
83 | Separation -> {|\medbreak|}
84 | _ -> ""
85 in
86 let post : _ format6 =
87 match level with
88 | Types.Line | Separation | Aesthetic | Simple -> ""
89 | Paragraph -> "@,"
90 in
91 Fmt.pf ppf (pre ^^ "@," ^^ post)
92
93let env name pp ?(with_break = false) ?(opts = []) ?(args = []) ppf content =
94 mbegin ppf name;
95 List.iter (Fmt.pf ppf "[%t]") opts;
96 List.iter (Fmt.pf ppf "{%t}") args;
97 pp ppf content;
98 mend ppf name;
99 break ppf (if with_break then Simple else Aesthetic)
100
101let indent pp ppf x = env "ocamlindent" pp ppf x
102
103let inline_code pp = create "ocamlinlinecode" pp
104
105let verbatim ppf x = env "verbatim" Fmt.string ppf x
106
107let pageref_star x = create "pageref*" Escape.ref x
108
109let hyperref s = create "hyperref" ~options:[ bind Escape.ref s ]
110
111let ref x = create "ref" Escape.ref x
112
113let emph pp = create "emph" pp
114
115let bold pp = create "bold" pp
116
117let subscript pp = create "textsubscript" pp
118
119let superscript pp = create "textsuperscript" pp
120
121let code_block pp ppf x =
122 let name = "ocamlcodeblock" in
123 mbegin ppf name;
124 Fmt.cut ppf ();
125 pp ppf x;
126 Fmt.cut ppf ();
127 mend ppf name
128
129let includegraphics pp = create "includegraphics" pp
130
131let section pp = create "section" pp
132
133let subsection pp = create "subsection" pp
134
135let subsubsection pp = create "subsubsection" pp
136
137let paragraph pp = create "paragraph" pp
138
139let enumerate pp ppf x = env "enumerate" pp ppf x
140
141let itemize pp ppf x = env "itemize" pp ppf x
142
143let raw_description pp ppf x = env "description" pp ppf x
144
145let href x pp ppf y =
146 create2 "href" (Escape.pp ~code_hyphenation:false) pp ppf x y
147
148let item ?options = create "item" ?options
149
150let description pp ppf x =
151 (* printing description inside a group make them more robust *)
152 let group_printer d ppf = Fmt.pf ppf "{%a}" pp d in
153 let elt ppf (d, elt) = item ~options:[ group_printer d ] pp ppf elt in
154 let all ppf x =
155 Fmt.pf ppf
156 {|\kern-\topsep
157\makeatletter\advance\%@topsepadd-\topsep\makeatother%% topsep is hardcoded
158|};
159 Fmt.list ~sep:(fun ppf () -> break ppf Aesthetic) elt ppf x
160 in
161 match x with
162 | [] -> () (* empty description are not supported *)
163 | _ :: _ -> raw_description all ppf x
164
165let url ppf s =
166 create "url" Fmt.string ppf (Escape.text ~code_hyphenation:false s)
167
168let footnote x = create "footnote" url x
169
170let rightarrow ppf = math "rightarrow" ppf
171
172(** Latex uses forward slash even on Windows. *)
173let latex_path ppf path =
174 let path_s = String.concat "/" (Fpath.segs path) in
175 Fmt.string ppf path_s
176
177let input ppf x = create "input" latex_path ppf x
178
179let ocamltabular ~column_desc pp ppf x =
180 env "ocamltabular" ~args:[ column_desc ] pp ppf x
181
182let small_table pp ppf (alignment, tbl) =
183 let columns = match tbl with [] -> 1 | _ -> List.length (List.hd tbl) in
184 let row ppf x =
185 let ampersand ppf () = Fmt.pf ppf "& " in
186 Fmt.list ~sep:ampersand pp ppf x;
187 break ppf Line
188 in
189 let matrix ppf m = List.iter (row ppf) m in
190 let column_desc =
191 let pp_alignment ppf align =
192 match align with
193 | Odoc_document.Types.Table.Default -> Fmt.pf ppf "p"
194 | Left -> Fmt.pf ppf "w{l}"
195 | Right -> Fmt.pf ppf "w{r}"
196 | Center -> Fmt.pf ppf "w{c}"
197 in
198 let cell ppf align =
199 Fmt.pf ppf "%a{%.3f\\textwidth}" pp_alignment align
200 (1.0 /. float_of_int columns)
201 in
202 match alignment with
203 | None ->
204 let rec repeat n s ppf =
205 if n = 0 then () else Fmt.pf ppf "%t%t" s (repeat (n - 1) s)
206 in
207 repeat columns (fun ppf -> cell ppf Default)
208 | Some alignment -> fun ppf -> List.iter (cell ppf) alignment
209 in
210 let table ppf tbl = ocamltabular ~column_desc matrix ppf tbl in
211 (* we add line breaks to never insert tables between delimiters,
212 to avoid rendering:
213 | `A
214 [ | `B ]
215 | `C
216 or
217 field_1: int;
218 { field_2: int; }
219 field_3: int;
220 *)
221 break ppf Line;
222 table ppf tbl;
223 break ppf Line
224
225let ocamltag tag pp ppf x = create2 "ocamltag" Fmt.string pp ppf tag x
226
227let math ppf x = Fmt.pf ppf {|$%s$|} x
228
229let equation ppf x =
230 let name = "equation*" in
231 mbegin ppf name;
232 Fmt.cut ppf ();
233 (* A blank line before \end{equation*} is a latex error,
234 we trim on the right the user input to avoid any surprise *)
235 let x = Astring.String.drop ~rev:true ~sat:Astring.Char.Ascii.is_white x in
236 Fmt.string ppf x;
237 Fmt.cut ppf ();
238 mend ppf name