@@ -45,6 +45,7 @@ type elt =
45
45
| Description of (t * t ) list
46
46
| Subpage of t
47
47
| Table of table
48
+ | Ligaturable of string
48
49
49
50
and section = {level :int ; label :string option ; content :t }
50
51
and list_info = { typ : Block .list_type ; items : t list }
@@ -243,9 +244,8 @@ let filter_map f x =
243
244
| None -> acc)
244
245
[] x
245
246
246
-
247
247
let elt_size (x :elt ) = match x with
248
- | Txt _ | Internal_ref _ | External_ref _ | Label _ | Style _ | Inlined_code _ | Code_fragment _ | Tag _ | Break _ -> Small
248
+ | Txt _ | Internal_ref _ | External_ref _ | Label _ | Style _ | Inlined_code _ | Code_fragment _ | Tag _ | Break _ | Ligaturable _ -> Small
249
249
| List _ | Section _ | Verbatim _ | Raw _ | Code_block _ | Subpage _ | Description _ -> Large
250
250
| Table _ -> Huge
251
251
@@ -268,6 +268,11 @@ let txt ~verbatim ~in_source ws =
268
268
| [] -> []
269
269
| l -> [ Txt l ]
270
270
271
+ let entity ~in_source ~verbatim x =
272
+ if in_source && not verbatim then
273
+ Ligaturable (escape_entity x)
274
+ else
275
+ Txt [escape_entity x]
271
276
272
277
let rec pp_elt ppf = function
273
278
| Txt words ->
@@ -296,6 +301,7 @@ let rec pp_elt ppf = function
296
301
| Table { row_size =Small |Empty ; tbl } -> small_table ppf tbl
297
302
| Label x -> mlabel ppf x
298
303
| Subpage x -> sub pp ppf x
304
+ | Ligaturable s -> Fmt. string ppf s
299
305
300
306
and pp ppf = function
301
307
| [] -> ()
@@ -304,6 +310,8 @@ and pp ppf = function
304
310
pp ppf ( t :: q )
305
311
| Break a :: (Break b :: q ) ->
306
312
pp ppf ( Break (max a b) :: q)
313
+ | Ligaturable "-" :: Ligaturable ">" :: q ->
314
+ Fmt. string ppf {|$ \rightarrow$| }; pp ppf q
307
315
| a :: q ->
308
316
pp_elt ppf a; pp ppf q
309
317
@@ -391,7 +399,7 @@ and inline ~in_source ~verbatim (l : Inline.t) =
391
399
| Source c ->
392
400
[Inlined_code (source (inline ~verbatim: false ~in_source: true ) c)]
393
401
| Raw_markup r -> raw_markup r
394
- | Entity s -> txt ~in_source ~verbatim: true [escape_entity s] in
402
+ | Entity s -> [entity ~in_source ~verbatim s] in
395
403
396
404
let take_text (l : Inline.t ) =
397
405
Doctree.Take. until l ~classify: (function
0 commit comments