File: biboutput.ml

package info (click to toggle)
bibtex2html 1.98-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 744 kB
  • ctags: 621
  • sloc: ml: 4,673; makefile: 690; perl: 50
file content (266 lines) | stat: -rw-r--r-- 7,819 bytes parent folder | download | duplicates (2)
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
(**************************************************************************)
(*  bibtex2html - A BibTeX to HTML translator                             *)
(*  Copyright (C) 1997-2014 Jean-Christophe Filliâtre 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).                                           *)
(**************************************************************************)

(*s Output a BibTeX bibliography. *)

open Printf
open Bibtex

let link_fields = ref []
let add_link_field f = link_fields := f :: !link_fields
let is_link_field f = List.mem f !link_fields

let needs_output k = function
  | None -> true
  | Some s -> KeySet.mem k s

let url_re = Str.regexp "\\(ftp\\|http\\)://.*"
let is_url s = Str.string_match url_re s 0

let print_atom html ch = function
  | Id s ->
      if html & not (abbrev_is_implicit s) then
	begin
	  Html.open_href ch ("#" ^ s);
	  output_string ch s;
	  Html.close_href ch
	end
      else
	output_string ch s
  | String s when html & is_url s ->
      output_string ch "{";
      Html.open_href ch s;
      output_string ch s;
      Html.close_href ch;
      output_string ch "}"
  | String s ->
      output_string ch ("{"^s^"}")

let print_atom_list html ch = function
  | [] -> ()
  | a::l ->
      print_atom html ch a;
      List.iter
	(fun a -> output_string ch " # "; print_atom html ch a)
	l

let print_crossref html ch = function
  | [String s] ->
      output_string ch "{";
      if html then Html.open_href ch ("#" ^ s);
      output_string ch s;
      if html then Html.close_href ch;
      output_string ch "}"
  | l ->
      if not !Options.quiet then
	eprintf "Warning: cross-references must be constant strings\n";
      if !Options.warn_error then exit 2;
      print_atom_list html ch l

let print_link_field ch = function
  | [String s] ->
      output_string ch "{";
      Html.open_href ch s;
      output_string ch s;
      Html.close_href ch;
      output_string ch "}"
  | l ->
      if not !Options.quiet then
	eprintf "Warning: web links must be constant strings\n";
      if !Options.warn_error then exit 2;
      print_atom_list true ch l

let print_command remove rename html html_file ch keys = function
  | Comment s ->
      if html then output_string ch "<pre>\n";
      output_string ch ("@comment{{" ^ s ^ "}}\n");
      if html then output_string ch "</pre>\n";
      output_string ch "\n"
  | Preamble l ->
      if html then output_string ch "<pre>\n";
      output_string ch "@preamble{";
      print_atom_list html ch l;
      output_string ch "}\n";
      if html then output_string ch "</pre>\n";
      output_string ch "\n"
  | Abbrev(s,l) ->
      if needs_output s keys then
	begin
	  if html then begin Html.open_anchor ch s; Html.close_anchor ch end;
	  if html then output_string ch "<pre>\n";
	  output_string ch ("@string{" ^ s ^ " = ");
	  print_atom_list html ch l;
	  output_string ch "}\n";
	  if html then output_string ch "</pre>\n";
	  output_string ch "\n"
	end
  | Entry (entry_type,key,fields) ->
      if needs_output key keys then
	begin
	  (*if html then Html.open_balise ch "p";*)
	  if html then begin Html.open_anchor ch key; Html.close_anchor ch end;
	  if html then output_string ch "<pre>\n";
	  output_string ch ("@" ^ entry_type ^ "{");
	  begin match html_file with
	    | Some f ->
		Html.open_href ch (f ^ "#" ^ key);
		output_string ch key;
		Html.close_href ch
	    | None ->
		output_string ch key
	  end;
	  List.iter
	    (fun (field,l) ->
               if not (List.mem field remove) then
                 begin
                   let ofield =
                     try List.assoc field rename
                     with Not_found -> field
                   in
	           output_string ch (",\n  " ^ ofield ^ " = ");
	           if html & field = "crossref" then
		     print_crossref html ch l
	           else if html & is_link_field field then
		     print_link_field ch l
	           else
		     print_atom_list html ch l
                 end)
	    fields;
	  output_string ch "\n}\n";
	  if html then output_string ch "</pre>\n";
	  (*if html then Html.close_balise ch "p";*)
	  output_string ch "\n"

	end

(*s PHP output *)

open Printf

exception Bad_input_for_php of string

(* inspired from String.escaped *)
let add_backslashes s =
  let n = ref 0 in
  for i = 0 to String.length s - 1 do
    n := !n +
      (match String.unsafe_get s i with
         | '\'' | '\\' -> 2
         | _ -> 1)
  done;
  if !n = String.length s then s else begin
    let s' = String.create !n in
    n := 0;
    for i = 0 to String.length s - 1 do
      let c = String.unsafe_get s i in
      begin match c with
        | ('\'' | '\\') -> String.unsafe_set s' !n '\\'; incr n
        | _ -> ()
      end;
      String.unsafe_set s' !n c; incr n
    done;
    s'
  end

let php_print_atom ch = function
  | Id s -> fprintf ch "\'%s\'" s
  | String s ->
      fprintf ch "'%s'" (add_backslashes s)

let php_print_atom_list ch = function
  | [] -> ()
  | [a] -> php_print_atom ch a
  | a::l ->
      php_print_atom ch a;
      List.iter
	(fun a ->
	   fprintf ch ".";
	   php_print_atom ch a)
	l

let php_print_command index remove rename ch keys =
  function
  | Comment s ->
      raise
	(Bad_input_for_php "comments not supported, use option --no-comment")
(*
      output_string ch "<pre>\n";
      output_string ch ("@comment{{" ^ s ^ "}}\n");
      output_string ch "</pre>\n";
      output_string ch "\n"
*)
  | Preamble l ->
      raise (Bad_input_for_php "preamble not supported")
(*
      output_string ch "<pre>\n";
      output_string ch "@preamble{";
      php_print_atom_list ch l;
      output_string ch "}\n";
      output_string ch "</pre>\n";
      output_string ch "\n"
*)
  | Abbrev(s,l) ->
      raise (Bad_input_for_php "string not supported, use option --expand")
(*
      if needs_output s keys then
	begin
	  Html.open_anchor ch s;
	  Html.close_anchor ch;
	  output_string ch "<pre>\n";
	  output_string ch ("@string{" ^ s ^ " = ");
	  php_print_atom_list ch l;
	  output_string ch "}\n";
	  output_string ch "</pre>\n";
	  output_string ch "\n"
	end
*)
  | Entry (entry_type,key,fields) ->
      if needs_output key keys then
	begin
	  if index > 0 then fprintf ch ",\n\n";
	  fprintf ch "%-5d => Array (\n" index;
	  fprintf ch "  \'entrytype\' => \'%s\',\n" entry_type;
	  fprintf ch "  \'cite\' => \'%s\'" key;
	  List.iter
	    (fun (field,l) ->
               if not (List.mem field remove) then
		 begin
		   let ofield =
                     try List.assoc field rename
                     with Not_found -> field
		   in
		   fprintf ch ",\n  \'%s\' => " ofield;
		   php_print_atom_list ch l
             end)
	    fields;
	  fprintf ch ")";
	  succ index
	end
      else index

let output_bib ?(remove=[]) ?(rename=[]) ?(php=false) ~html ?html_file
    ch bib keys =
  let _ =
    Bibtex.fold
      (fun entry i ->
	 if php then
	   php_print_command i remove rename ch keys entry
	 else
	   (print_command remove rename html html_file ch keys entry;
	    succ i))
      bib
    0
  in ()