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
|
(***********************************************************************)
(* *)
(* HEVEA *)
(* *)
(* Luc Maranget, projet PARA, INRIA Rocquencourt *)
(* *)
(* Copyright 1998 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
let verbose = ref 0
;;
let table = Hashtbl.create 37
;;
let add name file =
if !verbose > 0 then
prerr_endline ("Register "^name^" in "^file) ;
try
let _ = Hashtbl.find table name in
Location.print_pos () ;
prerr_endline ("Warning, multiple definitions for anchor: "^name) ;
with
| Not_found ->
Hashtbl.add table name file
;;
let decode_fragment frag =
let buff = Buffer.create 32 in
Url.decode_fragment (Buffer.add_char buff) (Buffer.add_string buff) frag ;
Buffer.contents buff
let fullname change myfilename name =
if !verbose > 1 then
Printf.eprintf "FULL: filename=%s, name=%s ->" myfilename name ;
let r =
try
let filename = Hashtbl.find table (decode_fragment name) in
let newname =
if myfilename = filename then
"#"^name
else
change filename^"#"^name in
if !verbose > 1 then
prerr_endline ("From "^name^" to "^newname) ;
newname
with Not_found -> begin
Location.print_pos () ;
prerr_endline ("Warning, cannot find anchor: "^name) ;
raise Not_found
end in
if !verbose > 1 then Printf.eprintf " %s\n" r ;
r
;;
let dump outname change =
try
let chan = open_out outname in
try
Hashtbl.iter
(fun k x -> Printf.fprintf chan "%s\t%s\n" k (change x))
table ;
close_out chan
with
| e -> close_out chan ; raise e
with
| Sys_error msg ->
prerr_endline ("Error while dumping "^outname^": "^msg)
|
