Skip to content

Commit 03aa365

Browse files
committed
latex backend: add ligature for ->
1 parent 7c4151d commit 03aa365

File tree

1 file changed

+11
-3
lines changed

1 file changed

+11
-3
lines changed

src/latex/generator.ml

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ type elt =
4545
| Description of (t * t) list
4646
| Subpage of t
4747
| Table of table
48+
| Ligaturable of string
4849

4950
and section = {level:int; label:string option; content:t }
5051
and list_info = { typ : Block.list_type; items: t list }
@@ -243,9 +244,8 @@ let filter_map f x =
243244
| None -> acc)
244245
[] x
245246

246-
247247
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
249249
| List _ | Section _ | Verbatim _ | Raw _ | Code_block _ | Subpage _ | Description _-> Large
250250
| Table _ -> Huge
251251

@@ -268,6 +268,11 @@ let txt ~verbatim ~in_source ws =
268268
| [] -> []
269269
| l -> [ Txt l ]
270270

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]
271276

272277
let rec pp_elt ppf = function
273278
| Txt words ->
@@ -296,6 +301,7 @@ let rec pp_elt ppf = function
296301
| Table { row_size=Small|Empty; tbl } -> small_table ppf tbl
297302
| Label x -> mlabel ppf x
298303
| Subpage x -> sub pp ppf x
304+
| Ligaturable s -> Fmt.string ppf s
299305

300306
and pp ppf = function
301307
| [] -> ()
@@ -304,6 +310,8 @@ and pp ppf = function
304310
pp ppf ( t :: q )
305311
| Break a :: (Break b :: q) ->
306312
pp ppf ( Break (max a b) :: q)
313+
| Ligaturable "-" :: Ligaturable ">" :: q ->
314+
Fmt.string ppf {|$\rightarrow$|}; pp ppf q
307315
| a :: q ->
308316
pp_elt ppf a; pp ppf q
309317

@@ -391,7 +399,7 @@ and inline ~in_source ~verbatim (l : Inline.t) =
391399
| Source c ->
392400
[Inlined_code (source (inline ~verbatim:false ~in_source:true) c)]
393401
| 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
395403

396404
let take_text (l: Inline.t) =
397405
Doctree.Take.until l ~classify:(function

0 commit comments

Comments
 (0)