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 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
|
(***********************************************************************)
(* *)
(* HEVEA *)
(* *)
(* Luc Maranget, projet PARA, INRIA Rocquencourt *)
(* *)
(* Copyright 1998 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
open Misc
let rtable = Hashtbl.create 17
;;
let rset name value = Hashtbl.add rtable name value
;;
let rget name =
try Hashtbl.find rtable name with Not_found -> begin
warning ("Undefined label: '"^name^"'") ; "??"
end
;;
let btable = Hashtbl.create 17
;;
let bset name value = Hashtbl.add btable name value
;;
let bget warn name =
let r =
try Some (Hashtbl.find btable name) with Not_found ->
begin
if warn then warning ("Undefined citation: '"^name^"'") ;
None
end in
r
;;
let auxfile = ref None
and auxname = ref ""
and something = ref false
and digest = ref None
;;
let read_digest name =
try
Some (Digest.file name)
with
| Sys_error _ -> None
let labelcount = ref 0
let rseen = Hashtbl.create 17
and bseen = Hashtbl.create 17
;;
(* result is true when another run is needed *)
let finalize check =
match !auxfile with
| None -> false
| Some file ->
close_out file ;
if not !something then Mysys.remove !auxname;
if check then begin
let changed = !digest <> read_digest !auxname in
if changed then
Misc.message
"HeVeA Warning: Label(s) may have changed. Rerun me to get cross-references right." ;
changed
end else
false
;;
let write output_fun = match !auxfile with
| None -> ()
| Some file ->
something := true ;
output_fun file
;;
let bcheck key =
try
let _ = Hashtbl.find bseen key in
warning ("Multiple definitions for citation: "^key) ;
false
with
| Not_found ->
Hashtbl.add bseen key () ;
true
let rcheck key =
try
let _ = Hashtbl.find rseen key in
warning ("Multiple definitions for label: "^key) ;
-1
with
| Not_found ->
let x = !labelcount in
incr labelcount ;
Hashtbl.add rseen key x ;
x
let swrite msg = match !auxfile with
| None -> ()
| Some file ->
something := true ;
output_string file msg
let bwrite key pretty =
if bcheck key then
write
(fun file ->
output_string file "\\bibcite{" ;
output_string file key ;
output_string file "}{" ;
output_string file pretty ;
output_string file "}\n")
and rwrite key pretty =
let idx = rcheck key in
if idx >= 0 then
write
(fun file ->
output_string file "\\newlabel{" ;
output_string file key ;
output_string file "}{{" ;
output_string file pretty ;
output_string file "}{X}}\n")
and rwrite2 anchor key pretty =
let idx = rcheck key in
if idx >= 0 then
write
(fun file ->
output_string file "\\new@anchor@label{" ;
output_string file anchor ;
output_string file "}{" ;
output_string file key ;
output_string file "}{{" ;
output_string file pretty ;
output_string file "}{X}}\n")
;;
type toc_t =
{mutable level : int ; mutable depth : int ; chan : out_channel }
let toctable = Hashtbl.create 5
;;
let tocfilename suf = Parse_opts.base_out^"."^suf
let do_addtoc toc level what =
(* First adjust nesting of tocenv *)
if level > toc.level then begin
for _i = toc.level to level-1 do
output_string toc.chan "\\begin{tocenv}\n"
done ;
toc.depth <- toc.depth + level - toc.level ;
toc.level <- level
end else if level < toc.level then begin
let nclose = min toc.depth (toc.level - level) in
for _i = 1 to nclose do
output_string toc.chan "\\end{tocenv}\n"
done ;
toc.depth <- toc.depth - nclose ;
if toc.depth=0 then begin
output_string toc.chan "\\begin{tocenv}\n" ;
toc.depth <- 1 ;
end ;
toc.level <- level
end ;
(* Then ouput toc item *)
Printf.fprintf toc.chan "\\tocitem %s\n" what
let addtoc suf level what =
try
try
let toc = Hashtbl.find toctable suf in
do_addtoc toc level what
with
| Not_found ->
let name = Parse_opts.base_out^"."^suf in
let chan = open_out name in
output_string chan "\\begin{tocenv}\n" ;
let toc = {level=level ; depth=1 ; chan=chan } in
Hashtbl.add toctable suf toc ;
do_addtoc toc level what
with
| Sys_error msg ->
Misc.warning
("Problem with toc file "^tocfilename suf^": "^msg)
(* To be performed aroound haux file reading *)
let init base =
digest := read_digest (base^".haux")
let final base =
Hashtbl.iter
(fun _ toc ->
for _i=1 to toc.depth do
output_string toc.chan "\\end{tocenv}\n" ;
done ;
close_out toc.chan)
toctable ;
Hashtbl.clear toctable ;
let filename = base^".haux" in
try
let file = open_out filename in
auxname := filename ;
auxfile := Some file
with Sys_error s ->
warning ("Cannot open out file: "^filename^" : "^s)
type saved =
(string, string) Hashtbl.t *
int * (string, int) Hashtbl.t *
(string, string) Hashtbl.t * (string, unit) Hashtbl.t *
out_channel option * string * bool * Digest.t option
let check () =
Hashtbl.copy rtable,
!labelcount,
Hashtbl.copy rseen,
Hashtbl.copy btable, Hashtbl.copy bseen,
!auxfile, !auxname, !something, !digest
let hot
(srtable, slabelcount, srseen, sbtable, sbseen,
sauxfile, sauxname, ssomething, sdigest) =
Misc.copy_hashtbl srtable rtable ;
labelcount := slabelcount ;
Misc.copy_hashtbl srseen rseen ;
Misc.copy_hashtbl sbtable btable ; Misc.copy_hashtbl sbseen bseen ;
auxfile := sauxfile ;
auxname := sauxname ;
something := ssomething ;
digest := sdigest
(* Valid only juste before reading main input file *)
let hot_start () =
Hashtbl.clear rtable ; labelcount := 0 ; Hashtbl.clear rseen ;
Hashtbl.clear btable ; Hashtbl.clear bseen ;
auxfile := None ;
auxname := "" ;
something := false ;
digest := None
|