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
module Id = Stk.Misc.Id()
type id = Id.t
let id_wrapper = Id.wrapper
let string_of_id id = string_of_int (Id.to_int id)
let id_of_string id = Id.of_int (int_of_string id)
type multiclip = {
abst_len : int ;
mutable elts : (string * string) Id.Map.t ;
}
let default_abst_len = 80;;
let create_multiclip ?(abst_len=default_abst_len) () =
{ abst_len = abst_len ;
elts = Id.Map.empty ;
}
;;
let chop_n_char n s =
let len = String.length s in
if len <= n +1 || n < 0 then
s
else
Printf.sprintf "%s..." (String.sub s 0 (n+1))
let split_string ?(keep_empty=false) s chars =
let len = String.length s in
let rec iter acc pos =
if pos >= len then
match acc with
"" -> []
| _ -> [acc]
else
if List.mem s.[pos] chars then
match acc with
"" ->
if keep_empty then
"" :: iter "" (pos + 1)
else
iter "" (pos + 1)
| _ -> acc :: (iter "" (pos + 1))
else
iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1)
in
iter "" 0
let replace_blanks s =
let l = split_string s ['\n';'\r';'\t';' '] in
String.concat " " l
;;
let gen_id =
let rec iter map =
let id = Id.gen () in
match Id.Map.find_opt id map with
| None -> id
| Some _ -> iter map
in
iter
let add t ?id ?abs contents =
let id = match id with
| None -> gen_id t.elts
| Some id -> id
in
let abstract =
match abs with
None -> replace_blanks (chop_n_char t.abst_len contents)
| Some s -> replace_blanks s
in
t.elts <- Id.Map.add id (abstract, contents) t.elts;
id
;;
let elements t = List.map (fun (id,(abs,str)) -> (id,abs,str)) (Id.Map.bindings t.elts)
let ids t = List.sort Id.compare (List.map (fun (id,_) -> id) (Id.Map.bindings t.elts))
let get t id = Id.Map.find_opt id t.elts
let remove t id = t.elts <- Id.Map.remove id t.elts
type storable_multiclip =
{ mutable clip : multiclip ;
file : string ;
op_group : [`Open] Ocf.group ;
op_abst_len : int Ocf.conf_option ;
op_elts : (id * string * string) list Ocf.conf_option ;
}
let create_storable_multiclip ?(abst_len=default_abst_len) file =
let op_elts = Ocf.list Ocf.Wrapper.(triple id_wrapper string string) [] in
let g = Ocf.add Ocf.group ["elements"] op_elts in
let op_abst_len = Ocf.int abst_len in
let g = Ocf.add g ["abstract_length"] op_abst_len in
let clip = create_multiclip ~abst_len () in
{ clip = clip ;
file = file ;
op_group = g ;
op_abst_len = op_abst_len ;
op_elts = op_elts ;
}
let read_multiclip t =
Ocf.from_file t.op_group t.file;
let clip = create_multiclip ~abst_len: (Ocf.get t.op_abst_len) () in
List.iter
(fun (id, abs, contents) -> ignore(add clip ~id ~abs contents))
(Ocf.get t.op_elts);
t.clip <- clip
;;
let write_multiclip t =
Ocf.set t.op_elts (elements t.clip);
Ocf.set t.op_abst_len t.clip.abst_len ;
Ocf.to_file t.op_group t.file
;;
let storable_get_multiclip t = t.clip;;
let storable_get_file t = t.file;;