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
|
(* (C) 1999-2004 *)
(* Cuihtlauac Alvarado, France Telecon, Recherche & Developement *)
(* Jean-Franois Monin, Universit Joseph Fourier - VERIMAG *)
(* $Id: vi.ml,v 1.4 2007-03-24 14:49:37 tews Exp $ *)
(* Store entries before writing them down. *)
let lifo : (string * int * int) list ref = ref []
let set_size_ml, get_size_ml =
let c = ref 0 in
let set n = c := n in
let get () = !c
in set, get
let add etag (loc, last) =
lifo := (etag, loc, last) :: !lifo; set_size_ml last
let escape s =
let part_es = String.escaped s in
let buffer = Buffer.create (String.length part_es) in
String.iter (fun c ->
match c with
| '$' | '/' ->
Buffer.add_char buffer '\\';
Buffer.add_char buffer c
| _ -> Buffer.add_char buffer c)
part_es;
Buffer.contents buffer
let line filename tagname linebeg =
let etag =
Printf.sprintf "%s\t%s\t/^%s$/;\n" tagname filename (escape linebeg) in
etag, (String.length etag)
let format filename (fs, l) =
let rec loop lcur scur = function
| [] -> lcur, scur
| (entry, pos, last) :: rest ->
let line_beg, _ = Editor.Line.of_pos pos in
let pos_cr =
(try String.index_from fs line_beg '\n'
with Not_found -> String.length fs) in
let len = (if pos_cr > line_beg then
if String.get fs (pos_cr-1) == '\r' then
pos_cr-1
else
pos_cr
else
pos_cr) - line_beg in
let fl, n =
line filename entry (String.sub fs line_beg len) in
loop (fl :: lcur) (n + scur) rest in
loop [] 0 !lifo
let header chan _ _ _ =
Printf.fprintf chan "!_TAG_FILE_FORMAT\t1\t/without ;\"/\n!_TAG_FILE_SORTED\t0\t/0=unsorted, 1=sorted/\n"
let ini modulename in_file =
Printf.sprintf "%s\t%s\t1;\n" modulename in_file, 0
let _ = at_exit (Editor.process_file ini header get_size_ml format)
|
