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
|
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
type style = {
book : [ `Full | `Abbr ];
book_sep : string;
chapter_verse : string;
range : string;
part_sep : string;
verse_sep : string;
}
let default_style =
{ book = `Abbr;
book_sep = " ";
chapter_verse = "{chapter}:{verses}";
range = "{first}-{last}";
part_sep = "; ";
verse_sep = ", " }
let part_sep st = st.part_sep
let range st = st.range
let book_sep st = st.book_sep
let book_string st = match st.book with `Full -> "full" | `Abbr -> "abbr"
(* Arabic -> Roman, for the {chapter_roman} placeholder. Lifted from
[Colitur_render.View.roman_numeral], which prints "Hebdomada I" week
headings -- roman numerals are idiomatic throughout this project's
output ("Feria IV"), so a citation style may want them too. *)
let roman_numeral n =
if n <= 0 then string_of_int n
else
let table =
[ (1000, "M"); (900, "CM"); (500, "D"); (400, "CD"); (100, "C");
(90, "XC"); (50, "L"); (40, "XL"); (10, "X"); (9, "IX");
(5, "V"); (4, "IV"); (1, "I") ]
in
let b = Buffer.create 8 in
let n = ref n in
List.iter
(fun (v, sym) ->
while !n >= v do
Buffer.add_string b sym;
n := !n - v
done)
table;
Buffer.contents b
let with_book b st = { st with book = b }
(* One matching pair of surrounding double quotes, and only that -- see the
.mli for why this is not in Overlay_ini. *)
let unquote s =
let n = String.length s in
if n >= 2 && s.[0] = '"' && s.[n - 1] = '"' then String.sub s 1 (n - 2) else s
(* Replace {name} with its value. An UNKNOWN placeholder survives
literally: a typo in a hand-written style file must be visible in the
output, not silently swallowed. *)
let subst tmpl pairs =
let n = String.length tmpl in
let b = Buffer.create (n + 16) in
let i = ref 0 in
while !i < n do
if tmpl.[!i] = '{' then
match String.index_from_opt tmpl !i '}' with
| None ->
Buffer.add_char b tmpl.[!i];
incr i
| Some j ->
let name = String.sub tmpl (!i + 1) (j - !i - 1) in
(match List.assoc_opt name pairs with
| Some v -> Buffer.add_string b v
| None -> Buffer.add_string b (String.sub tmpl !i (j - !i + 1)));
i := j + 1
else begin
Buffer.add_char b tmpl.[!i];
incr i
end
done;
Buffer.contents b
let render st ~names (t : Parse.t) =
let show_num (v : Parse.verse_num) = string_of_int v.Parse.n ^ v.Parse.suffix in
let one_range (r : Parse.verse_range) =
match r.Parse.last with
| None -> show_num r.Parse.first
| Some l -> subst st.range [ ("first", show_num r.Parse.first); ("last", show_num l) ]
in
let one_part (p : Parse.part) =
let verses = String.concat st.verse_sep (List.map one_range p.Parse.verses) in
subst st.chapter_verse
[ ("chapter", string_of_int p.Parse.chapter);
("chapter_roman", roman_numeral p.Parse.chapter);
("verses", verses) ]
in
let body = String.concat st.part_sep (List.map one_part t.Parse.parts) in
names t.Parse.book st.book ^ st.book_sep ^ body
let style_of_fields fields =
let get k d = match List.assoc_opt k fields with Some v -> unquote v | None -> d in
{ book = (if get "book" "abbr" = "full" then `Full else `Abbr);
book_sep = get "book_sep" default_style.book_sep;
chapter_verse = get "chapter_verse" default_style.chapter_verse;
range = get "range" default_style.range;
part_sep = get "part_sep" default_style.part_sep;
verse_sep = get "verse_sep" default_style.verse_sep }
|