File: html.ml

package info (click to toggle)
bibtex2html 1.98-5
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 756 kB
  • sloc: ml: 4,673; makefile: 690; perl: 50; sh: 15
file content (126 lines) | stat: -rw-r--r-- 3,502 bytes parent folder | download | duplicates (5)
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
(**************************************************************************)
(*  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 Production of HTML syntax. *)

open Printf

let bgcolor = ref None
let css = ref None

let defaultcharset = "ISO-8859-1"
let charset =
  ref (try
	 let c = Unix.open_process_in "/usr/bin/locale charmap"
	 in let s = input_line c
	 in begin
	     Unix.close_process_in c;
	     if s = "" then defaultcharset else s
	   end
       with
	   _ -> defaultcharset)
    
let open_document ch ftitle =
  output_string ch
    "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n\n";
  output_string ch "<html>\n\n<head>\n";
  output_string ch "<title>"; ftitle(); output_string ch "</title>\n";
  fprintf ch
    "<meta http-equiv=\"content-type\" content=\"text/html; charset=%s\">\n"
    !charset;
  output_string ch "<meta name=\"generator\" content=\"bibtex2html\">\n";

  begin match !css with
    | None -> ()
    | Some f ->
	fprintf ch "<link rel=stylesheet type=\"text/css\" href=\"%s\">\n" f
  end;
  output_string ch "</head>\n\n";
  begin match !bgcolor with
    | None -> output_string ch "<body>\n"
    | Some color -> fprintf ch "<body bgcolor=%s>\n" color
  end;
  flush ch


let close_document ch =
  output_string ch "</body>\n</html>\n";
  flush ch


let open_balise ch s =
  output_string ch ("<" ^ s ^ ">");
  flush ch

let close_balise ch s =
  output_string ch ("</" ^ s ^ ">");
  flush ch


let open_anchor ch s =
  open_balise ch ("a name=\"" ^ s ^ "\"")

let close_anchor ch =
  close_balise ch "a"


let absolute_url_regexp = Str.regexp "\\(.+://\\)\\|#\\|mailto:"

let is_absolute_url u =
  try Str.search_forward absolute_url_regexp u 0 = 0 with Not_found -> false

let is_relative_url u = not (is_absolute_url u)

let amp = Str.regexp_string "&"

let open_href ch s =
  let s = Str.global_replace amp "&amp;" s in
  open_balise ch ("a href=\"" ^ s ^ "\"")

let close_href ch =
  close_balise ch "a"

let open_h ch i =
  open_balise ch (sprintf "h%d" i)

let close_h ch i =
  close_balise ch (sprintf "h%d" i)

let open_em ch =
  open_balise ch "em"

let close_em ch =
  close_balise ch "em"

let open_b ch =
  open_balise ch "b"

let close_b ch =
  close_balise ch "b"

let paragraph ch =
  open_balise ch "p"

let h_title ch n title =
  let s = sprintf "h%d" n in
  open_balise ch s;
  output_string ch title;
  close_balise ch s

let h1_title ch s = h_title ch 1 s
let h2_title ch s = h_title ch 2 s