File: bibtex.ml

package info (click to toggle)
bibtex2html 1.85-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 464 kB
  • ctags: 441
  • sloc: ml: 3,213; makefile: 250; sh: 155; perl: 50
file content (302 lines) | stat: -rw-r--r-- 7,416 bytes parent folder | download
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
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
(*
 * bibtex2html - A BibTeX to HTML translator
 * Copyright (C) 1997-2000 Jean-Christophe Fillitre and Claude March
 * 
 * This software is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public
 * License version 2, as published by the Free Software Foundation.
 * 
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 * 
 * See the GNU General Public License version 2 for more details
 * (enclosed in the file GPL).
 *)

(*i $Id: bibtex.ml,v 1.23 2005/12/16 08:39:35 filliatr Exp $ i*)

(*s Datatype for BibTeX bibliographies. *)

type entry_type = string
		    
type key = string

module KeySet = Set.Make(struct type t = key let compare = compare end)
	     
type atom =
  | Id of string
  | String of string

type command = 
  | Comment of string
  | Preamble of atom list
  | Abbrev of string * atom list
  | Entry  of entry_type * key * (string * atom list) list

(*s biblio is stored as a list. Beware, this in reverse order: the
   first entry is at the end of the list. This is intentional! *)

type biblio = command list

let empty_biblio = []

let size b = List.length b

(*s the natural iterator on biblio must start at the first entry, so it
   is the [fold_right] function on lists, NOT the [fold_left]! *)

let fold = List.fold_right

let find_entry key biblio =
  let rec find key b =
    match b with
      | [] -> raise Not_found
      | (Entry (_,s,_) as e) :: b ->
	  if String.uppercase s = key then e else find key b
      | _ :: b -> find key b
  in find (String.uppercase key) biblio

let add_new_entry command biblio = command :: biblio

let rec remove_entry key biblio =
  match biblio with
    | [] -> raise Not_found
    | (Entry(_,s,_) as e) :: b ->
	if s = key then b else e :: (remove_entry key b)
    | e :: b -> e :: (remove_entry key b)

(*s [add_entry k c b] adds an entry of key [k] and command [c] in
   biblio [b] and returns the new biblio. If an entry of key [k]
   already exists in [b], it is replaced by the new one. *)

let add_entry command biblio =
  match command with
    | Entry(_,key,_) ->
	begin
	  try
	    let new_bib = remove_entry key biblio in
	    command :: new_bib
	  with Not_found -> 
	    command :: biblio
	end
    | _ -> command::biblio

let merge_biblios b1 b2 =
  let b2keys =
    fold
      (fun entry accu -> match entry with
	 | Entry (_,key,_) -> KeySet.add key accu
	 | _ -> accu)
      b2
      KeySet.empty
  and b1abbrevs =
    fold
      (fun entry accu -> match entry with
	 | Abbrev (key,_) -> KeySet.add key accu
	 | _ -> accu)
      b1
      KeySet.empty
  in
  let new_b1 = 
    fold
      (fun entry accu -> match entry with
	 | Entry (_,key,_) -> 
	     if KeySet.mem key b2keys then 
	       begin
		 Format.eprintf "Warning, key '%s' duplicated@." key;
		 if !Options.warn_error then exit 2;
		 accu 
	       end 
	     else entry :: accu
	 | _ -> entry :: accu)
      b1
      empty_biblio
  in
  let new_bib =
    fold
      (fun entry accu -> match entry with
	 | Abbrev (key,_) -> 
	     if KeySet.mem key b1abbrevs then 
	       begin
		 Format.eprintf "Warning, key '%s' duplicated@." key;
		 if !Options.warn_error then exit 2;
		 accu 
	       end 
	     else entry :: accu
	 | _ -> entry :: accu)
      b2
      new_b1
  in
  new_bib

let month_env =
  List.map
    (fun s -> (s,[Id s]))
    [ "JAN" ; "FEB" ; "MAR" ; "APR" ; "MAY" ; "JUN" ;
      "JUL" ; "AUG" ; "SEP" ; "OCT" ; "NOV" ; "DEC" ]

let abbrev_is_implicit key =
  try
    let _ = int_of_string key in true
  with Failure "int_of_string" ->
    try
      let _ = List.assoc key month_env in true
    with Not_found -> false

(*i
let rec abbrev_exists key biblio =
  match biblio with
    | [] -> false
    | (Abbrev (s,_)) :: b -> s = key || abbrev_exists key b
    | _ :: b -> abbrev_exists key b
i*)

let rec find_abbrev key biblio =
  match biblio with
    | [] -> raise Not_found
    | (Abbrev (s,_) as e) :: b -> 
	if s = key then e
	else find_abbrev key b
    | _ :: b -> find_abbrev key b

let concat_atom_lists a1 a2 = 
  match (a1,a2) with
    | ([String s1], [String s2]) -> [String (s1 ^ s2)]
    | _ -> a1 @ a2

let abbrev_table = Hashtbl.create 97

let add_abbrev a l = Hashtbl.add abbrev_table a l

let _ = List.iter (fun (a,l) -> add_abbrev a l) month_env

let find_abbrev_in_table a = Hashtbl.find abbrev_table a

let rec expand_list = function
  | [] -> []
  | ((Id s) as a) :: rem ->
      begin
	try 
	  let v = find_abbrev_in_table s in
	  concat_atom_lists v (expand_list rem)
	with Not_found -> 
	  concat_atom_lists [a] (expand_list rem)
      end
  | ((String _) as a) :: rem ->
      concat_atom_lists [a] (expand_list rem)

let rec expand_fields = function
  | [] ->  []
  | (n,l) :: rem -> (n, expand_list l) :: (expand_fields rem)

let rec expand_abbrevs biblio = 
  fold 
    (fun command accu ->
       match command with
	 | Abbrev (a,l) ->
	     let s = expand_list l in
	     add_abbrev a s; 
	     accu
	 | Entry (t,k,f) ->
	     Entry (t,k,expand_fields f) :: accu
	 | e ->
	     e :: accu)
    biblio
    []

let rec expand_crossrefs biblio = 
  let crossref_table = Hashtbl.create 97 in
  let add_crossref a l = Hashtbl.add crossref_table (String.uppercase a) l in
  let find_crossref a = Hashtbl.find crossref_table (String.uppercase a) in
  let replace_crossref a l = 
    Hashtbl.replace crossref_table (String.uppercase a) l 
  in
  List.iter 
    (fun command ->
       match command with
	 | Entry (t,k,f) ->
	     begin
	       try
		 match List.assoc "CROSSREF" f with
		   | [String(s)] -> 
		       add_crossref s []
		   | _ -> 
		       begin
			 Format.eprintf 
			   "Warning: invalid cross-reference in entry '%s'.@." k;
			 if !Options.warn_error then exit 2;
		   end
	       with Not_found -> ();
	     end
	 | _ -> ())
    biblio;
  List.iter 
    (fun command ->
       match command with
	 | Entry (t,k,f) ->
	     begin
	       try 
		 let _ = find_crossref k in
		 if !Options.debug then
		   Format.eprintf "recording cross-reference '%s'.@." k;
		 replace_crossref k f
	       with Not_found -> ()
	     end
	 | _ -> ())
    biblio;
  fold 
    (fun command accu ->
       match command with
	 | Entry (t,k,f) ->
	     begin
	       try
		 match List.assoc "CROSSREF" f with
		   | [String(s)] -> 
		       begin
			 try 
			   let f' = find_crossref s in
			   if f' = [] then
			     begin
			       Format.eprintf 
				 "Warning: cross-reference '%s' not found.@." s;
			       if !Options.warn_error then exit 2;
			     end;
			   Entry (t,k,f@f') :: accu
			 with Not_found ->
			   assert false
		       end
		   | _ ->  command :: accu
	       with Not_found -> command :: accu
	     end
	 | e ->
	     e :: accu)
    biblio
    []



let sort comp bib = 
  let comments,preambles,abbrevs,entries =
    List.fold_left
      (fun (c,p,a,e) command ->
	 match command with
	   | Comment _ -> (command::c,p,a,e)
	   | Preamble _ -> (c,command::p,a,e)
	   | Abbrev _ -> (c,p,command::a,e)
	   | Entry _ -> (c,p,a,command::e))
      ([],[],[],[])
      bib
  in
  let sort_abbrevs = List.sort comp abbrevs
  and sort_entries = List.sort comp entries
  in
  List.rev_append sort_entries
    (List.rev_append sort_abbrevs
       (List.rev_append preambles (List.rev comments)))




let current_key = ref ""