-
Notifications
You must be signed in to change notification settings - Fork 80
/
annot.satyh
54 lines (43 loc) · 1.44 KB
/
annot.satyh
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
@require: pervasives
@require: color
@require: gr
@require: option
module Annot : sig
direct \href : [(length * color)?; string; inline-text] inline-cmd
val link-to-uri-frame : string -> (length * color) option -> deco-set
val link-to-location-frame : string -> (length * color) option -> deco-set
val register-location-frame : string -> deco-set
end = struct
let link-to-uri-frame uri borderopt =
let deco (x, y) w h d =
let () = register-link-to-uri uri (x, y) w h d borderopt in []
in
(deco, deco, deco, deco)
let link-to-location-frame name borderopt =
let deco (x, y) w h d =
let () = register-link-to-location name (x, y) w h d borderopt in []
in
(deco, deco, deco, deco)
let-inline ctx \href ?:borderopt uri inner =
let ib = read-inline ctx inner in
let ibL =
match get-leftmost-script ib with
| Some(scriptL) -> script-guard scriptL inline-nil
| None -> inline-nil
in
let ibR =
match get-rightmost-script ib with
| Some(scriptR) -> script-guard scriptR inline-nil
| None -> inline-nil
in
let ib-frame =
inline-frame-breakable (0pt, 0pt, 0pt, 0pt) (link-to-uri-frame uri borderopt) ib
in
ibL ++ ib-frame ++ ibR
let register-location-frame key =
let decoR (x, y) w h d =
let () = register-destination key (x, y +' h) in []
in
let decoI _ _ _ _ = [] in
(decoR, decoR, decoI, decoI)
end