blob: 53fdd46a935998485a9636f482037fc4e9309920 (
plain) (
blame)
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
|
type flavour = Latex | Groff | Html | Xml | Ics | None_
let all = [ Latex; Groff; Html; Xml; Ics; None_ ]
let to_string = function
| Latex -> "latex" | Groff -> "groff" | Html -> "html"
| Xml -> "xml" | Ics -> "ics" | None_ -> "none"
let of_string = function
| "latex" -> Some Latex | "groff" -> Some Groff | "html" -> Some Html
| "xml" -> Some Xml | "ics" -> Some Ics | "none" -> Some None_
| _ -> None
let of_extension = function
| ".tex" -> Some Latex
| ".ms" | ".mom" | ".me" -> Some Groff
| ".html" | ".htm" -> Some Html
| ".xml" -> Some Xml
| ".ics" -> Some Ics
| ".md" | ".adoc" | ".txt" -> Some None_
| _ -> None
(* Replace each character with its expansion, in ONE pass. A sequence of
String.concat replacements would double-escape: "&" -> "\\&" then the
backslash rule would rewrite the backslash it just introduced. *)
let expand f s =
let b = Buffer.create (String.length s + 16) in
String.iter (fun c -> Buffer.add_string b (f c)) s;
Buffer.contents b
let latex = function
| '\\' -> "\\textbackslash{}"
| '{' -> "\\{" | '}' -> "\\}"
| '$' -> "\\$" | '&' -> "\\&" | '#' -> "\\#"
| '_' -> "\\_" | '%' -> "\\%"
| '^' -> "\\textasciicircum{}"
| '~' -> "\\textasciitilde{}"
| c -> String.make 1 c
let html = function
| '&' -> "&" | '<' -> "<" | '>' -> ">"
| '"' -> """ | '\'' -> "'"
| c -> String.make 1 c
let ics = function
| '\\' -> "\\\\" | ';' -> "\\;" | ',' -> "\\,"
| '\n' -> "\\n" | '\r' -> ""
| c -> String.make 1 c
(* groff: a backslash starts an escape, and a '.' or '\'' in COLUMN ONE starts a
request. \& is the zero-width non-printing character that defuses it. *)
let groff s =
let escaped = expand (function '\\' -> "\\e" | c -> String.make 1 c) s in
if String.length escaped > 0 && (escaped.[0] = '.' || escaped.[0] = '\'') then "\\&" ^ escaped
else escaped
let apply flavour s =
match flavour with
| Latex -> expand latex s
| Groff -> groff s
| Html | Xml -> expand html s
| Ics -> expand ics s
| None_ -> s
(* RFC 5545 section 3.1. A continuation byte is 0x80-0xBF; backing off to a
non-continuation byte keeps every fold on a character boundary. *)
let fold_ics line =
let n = String.length line in
let b = Buffer.create (n + (n / 70) + 8) in
let is_cont c = Char.code c land 0xC0 = 0x80 in
let rec go pos first =
let limit = if first then 75 else 74 (* the leading space costs one octet *) in
if n - pos <= limit then (
if not first then Buffer.add_char b ' ';
Buffer.add_string b (String.sub line pos (n - pos));
Buffer.add_string b "\r\n")
else begin
let cut = ref (pos + limit) in
while !cut > pos && is_cont line.[!cut] do decr cut done;
if not first then Buffer.add_char b ' ';
Buffer.add_string b (String.sub line pos (!cut - pos));
Buffer.add_string b "\r\n";
go !cut false
end
in
go 0 true;
Buffer.contents b
|
