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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
type statement = { sid : int; text : string; children : statement list }
type t = { statements : statement list; next_sid : int }
type where = After | Down | Up
let of_outline (lines : (int * string) list) : t =
let next = ref 0 in
let rec level depth lines =
match lines with
| (d, text) :: rest when d >= depth ->
incr next;
let sid = !next in
let children, rest = level (depth + 1) rest in
let siblings, rest = level depth rest in
({ sid; text; children } :: siblings, rest)
| _ -> ([], lines)
in
let statements, _ = level 0 lines in
{ statements; next_sid = !next + 1 }
let rec find_in (l : statement list) sid : statement option =
List.fold_left
(fun found s -> match found with Some _ -> found | None -> if s.sid = sid then Some s else find_in s.children sid)
None l
let get t sid = find_in t.statements sid
let rec path_in (l : statement list) sid : int list option =
let rec go i = function
| [] -> None
| s :: rest -> (
if s.sid = sid then Some [ i ] else match path_in s.children sid with Some p -> Some (i :: p) | None -> go (i + 1) rest)
in
go 0 l
let rec letters n = if n < 26 then String.make 1 (Char.chr (97 + n)) else letters ((n / 26) - 1) ^ letters (n mod 26)
let number_of_path path = String.concat "" (List.mapi (fun depth i -> if depth mod 2 = 0 then string_of_int (i + 1) else letters i) path)
let number t sid = Option.map number_of_path (path_in t.statements sid)
let name_of (text : string) : string option =
if String.length text > 2 && text.[0] = '(' then
match String.index_opt text ')' with Some j when j > 1 -> Some (String.sub text 1 (j - 1)) | _ -> None
else None
let rec all (l : statement list) = List.concat_map (fun s -> s :: all s.children) l
let find t (target : string) : int option =
let target = String.lowercase_ascii (String.trim target) in
let statements = all t.statements in
match List.find_opt (fun s -> Option.map String.lowercase_ascii (name_of s.text) = Some target) statements with
| Some s -> Some s.sid
| None -> Option.map (fun s -> s.sid) (List.find_opt (fun s -> number t s.sid = Some target) statements)
let rec place (l : statement list) ~target where (news : statement) : statement list * bool =
match l with
| [] -> ([], false)
| s :: rest ->
if s.sid = target then
match where with
| After | Up -> (s :: news :: rest, true)
| Down -> ({ s with children = news :: s.children } :: rest, true)
else if where = Up && List.exists (fun c -> c.sid = target) s.children then (s :: news :: rest, true)
else
let children, found = place s.children ~target where news in
if found then ({ s with children } :: rest, true)
else
let rest, found = place rest ~target where news in
(s :: rest, found)
let rec map_statement (l : statement list) sid f : statement list =
List.map (fun s -> if s.sid = sid then f s else { s with children = map_statement s.children sid f }) l
let rec remove (l : statement list) sid : statement list =
List.filter_map (fun s -> if s.sid = sid then None else Some { s with children = remove s.children sid }) l
let insert t ~target where text =
let news = { sid = t.next_sid; text; children = [] } in
let statements, found = place t.statements ~target where news in
if found then ({ statements; next_sid = t.next_sid + 1 }, news.sid) else (t, news.sid)
let set_text t sid text = { t with statements = map_statement t.statements sid (fun s -> { s with text }) }
let delete t sid = { t with statements = remove t.statements sid }
let inside (branch : statement) target = List.exists (fun s -> s.sid = target) (all [ branch ])
let move t sid ~target where =
match get t sid with
| Some branch when not (inside branch target) ->
let statements, found = place (remove t.statements sid) ~target where branch in
if found then Some { t with statements } else None
| _ -> None
let copy t sid ~target where =
match get t sid with
| Some branch when not (inside branch target) ->
let next = ref t.next_sid in
let rec fresh s =
let sid = !next in
incr next;
{ s with sid; children = List.map fresh s.children }
in
let copied = fresh branch in
let statements, found = place t.statements ~target where copied in
if found then Some { statements; next_sid = !next } else None
| _ -> None
let visible t ~levels : (statement * int) list =
let rec go depth l =
List.concat_map
(fun s -> (s, depth) :: (match levels with Some n when depth + 1 >= n -> [] | _ -> go (depth + 1) s.children))
l
in
go 0 t.statements
let links (text : string) : (int * int * string) list =
let n = String.length text in
let rec go i acc =
match String.index_from_opt text i '<' with
| None -> List.rev acc
| Some a -> (
match String.index_from_opt text a '>' with
| Some b when b > a + 1 -> go (b + 1) ((a, b + 1, String.sub text (a + 1) (b - a - 1)) :: acc)
| _ -> go (a + 1) acc)
in
if n = 0 then [] else go 0 []
let word_at (text : string) (i : int) : (int * int) option =
let n = String.length text in
let i = ref (max 0 (min i (n - 1))) in
if n = 0 then None
else begin
while !i < n && text.[!i] = ' ' do incr i done;
if !i >= n then None
else begin
let a = ref !i and b = ref !i in
while !a > 0 && text.[!a - 1] <> ' ' do decr a done;
while !b < n && text.[!b] <> ' ' do incr b done;
Some (!a, !b)
end
end