File: output_latex.ml

package info (click to toggle)
caml2html 1.4.3-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd, stretch
  • size: 300 kB
  • sloc: ml: 1,996; makefile: 162
file content (363 lines) | stat: -rw-r--r-- 9,293 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
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
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
(* $Id$ *)
(* 
   Copyright 2002-2004 S´┐Żbastien Ailleret
   Copyright 2004, 2010 Martin Jambon
   
   This file is distributed under the terms of the GNU Public License
   http://www.gnu.org/licenses/gpl.txt
*)

(*
   This module provides functions that parse OCaml source code and return
   a list of tokens which are suitable for automatic syntax highlighting.
   Any input is accepted. Only a lexical analysis is performed and thus can
   be used to highlight incorrect programs as well as derivatives
   of OCaml (.ml .mli .mll .mly).
*)

open Printf


type class_definition = (string list * (string * string) list)

let rgb1 (r, g, b) =
  sprintf "%.2f,%.2f,%.2f"
    (float r /. 255.)
    (float g /. 255.)
    (float b /. 255.)

let rgb255 (r, g, b) =
  sprintf "%i,%i,%i" r g b

let color1 = 0, 128, 0
let color2 = 119, 170, 170
let color3 = 204, 153, 0
let color4 = 153, 0, 153
let color5 = 128, 128, 128
let color6 = 255, 0, 0
let color7 = 0, 51, 204
let color8 = 153, 0, 0
let color9 = 170, 68, 68

let key_color1 = Some (rgb1 color1)
let key_color2 = Some (rgb1 color2)
let key_color3 = Some (rgb1 color3)
let key_color4 = Some (rgb1 color4)
let key_color5 = Some (rgb1 color5)
let key_color6 = Some (rgb1 color6)

let construct_color = (Some (rgb1 color7), "Cconstructor")
let comment_color = (Some (rgb1 color8), "Ccomment")
let string_color = (Some (rgb1 color9), "Cstring")
let quotation_color = (None, "Cquotation")
let linenum_color = (None, "Clinenum")

let alpha_keyword_color = (key_color5, "Calphakeyword")
let nonalpha_keyword_color = (None, "Cnonalphakeyword")

let default_keyword_color_list =
  [
    "and", (key_color1, "Cand");
    "as", (key_color1, "Cas");
    "class", (key_color1, "Cclass");
    "constraint", (key_color1, "Cconstraint");
    "exception", (key_color1, "Cexception");
    "external", (key_color1, "Cexternal");
    "fun", (key_color1, "Cfun");
    "function", (key_color1, "Cfunction");
    "functor", (key_color1, "Cfunctor");
    "in", (key_color1, "Cin");
    "inherit", (key_color1, "Cinherit");
    "initializer", (key_color1, "Cinitializer");
    "let", (key_color1, "Clet");
    "method", (key_color1, "Cmethod");
    "module", (key_color1, "Cmodule");
    "mutable", (key_color1, "Cmutable");
    "of", (key_color1, "Cof");
    "private", (key_color1, "Cprivate");
    "rec", (key_color1, "Crec");
    "type", (key_color1, "Ctype");
    "val", (key_color1, "Cval");
    "virtual", (key_color1, "Cvirtual");
    
    "do", (key_color2, "Cdo");
    "done", (key_color2, "Cdone");
    "downto", (key_color2, "Cdownto");
    "else", (key_color2, "Celse");
    "for", (key_color2, "Cfor");
    "if", (key_color2, "Cif");
    "lazy", (key_color2, "Clazy");
    "match", (key_color2, "Cmatch");
    "new", (key_color2, "Cnew");
    "or", (key_color2, "Cor");
    "then", (key_color2, "Cthen");
    "to", (key_color2, "Cto");
    "try", (key_color2, "Ctry");
    "when", (key_color2, "Cwhen");
    "while", (key_color2, "Cwhile");
    "with", (key_color2, "Cwith");
    
    "assert", (key_color3, "Cassert");
    "include", (key_color3, "Cinclude");
    "open", (key_color3, "Copen");
    
    "begin", (key_color4, "Cbegin");
    "end", (key_color4, "Cend");
    "object", (key_color4, "Cobject");
    "sig", (key_color4, "Csig");
    "struct", (key_color4, "Cstruct");
    
    "raise", (key_color6, "Craise");

    "asr", (key_color5, "Casr");
    "land", (key_color5, "Cland");
    "lor", (key_color5, "Clor");
    "lsl", (key_color5, "Clsl");
    "lsr", (key_color5, "Clsr");
    "lxor", (key_color5, "Clxor");
    "mod", (key_color5, "Cmod");
    
    "false", (None, "Cfalse");
    "true", (None, "Ctrue");

    "|", (key_color2, "Cbar");
  ]

let default_keyword_colors =
  let tbl = Hashtbl.create 100 in
  List.iter
    (fun (s, (color, css_class)) -> 
       Hashtbl.add tbl s (color, css_class))
    default_keyword_color_list;
  tbl

let all_colors =
  linenum_color ::
    construct_color ::
    comment_color ::
    string_color ::
    quotation_color ::
    alpha_keyword_color ::
    nonalpha_keyword_color ::
    (List.map snd default_keyword_color_list)

let make_defs
  ?(colors = all_colors) () =
  let buf = Buffer.create 2000 in

  List.iter (
    fun (fg, name) -> 
      match fg with 
	  None ->
            bprintf buf "\
\\newcommand\\%s[1]{#1}
"
              name
	| Some color ->
            bprintf buf "\
\\definecolor{%sColor}{rgb}{%s}
\\newcommand\\%s[1]{\\textcolor{%sColor}{#1}}
"
              name color
              name name
  ) colors;

  Buffer.contents buf

  
let make_defs_file
    ?(colors = all_colors)
    file =
  let oc = open_out file in
  output_string oc (make_defs ~colors ());
  close_out oc

let default_style = make_defs ()

type param = {
  line_numbers : bool; 
  title : bool;
  body_only : bool;
  tab_size : int;
  latex_comments : bool;
  defs : string;
}

let default_param = {
  line_numbers = false; 
  title = false;
  body_only = false;
  tab_size = 8;
  latex_comments = false;
  defs = default_style;
}


let add_string buf s = 
  String.iter
    (function
	 '\\' -> Buffer.add_string buf "\\(\\backslash\\)"
       | '{' -> Buffer.add_string buf "\\{"
       | '}' -> Buffer.add_string buf "\\}"
       | c -> Buffer.add_char buf c)
    s


let line_comment p buf i =
  if p.line_numbers then
    bprintf buf "\\Clinenum{%4i}: " i

 
let colorize ?(comment = false) p buf style s =
  let add =
    if comment && p.latex_comments then Buffer.add_string buf
    else add_string buf in
  let _, clas = style in
  bprintf buf "\\%s{" clas;
  add s;
  Buffer.add_string buf "}"



let rec fold_left f accu l =
  match l with
      [] -> accu
    | a :: rest -> fold_left f (f accu a rest) rest

let ocaml
  ?(keyword_colors = default_keyword_colors)
  ?(param = default_param)
  buf l =
  
  let _last_line =
    fold_left
      (fun line token rest ->
	 match token with
	     `String s ->
	       colorize param buf string_color s;
	       line
	   | `Quotation s ->
	       colorize param buf quotation_color s;
	       line
	   | `Token s ->
	       add_string buf s;
	       line
	   | `Comment s ->
	       colorize ~comment:true param buf comment_color s;
	       line
	   | `Special_comment (handler_name, s0) ->
	       let html = 
		 match Plugin.expand handler_name s0 with
		     None -> 
		       failwith (
			 sprintf "Handler %s failed on line %i with input %s"
			   handler_name line s0
		       )
		   | Some s -> s
	       in
	       bprintf buf "\\end{alltt}%s\\begin{alltt}" html;
	       line + (Plugin.count_newlines s0)
	   | `Construct s ->
	       colorize param buf construct_color s;
	       line
	   | `Keyword k ->
	       (try 
		  let color = Hashtbl.find keyword_colors k in
		  colorize param buf color k;
		with Not_found -> 
		  let color =
		    match k.[0] with
			'a' .. 'z' -> alpha_keyword_color
		      | _ -> nonalpha_keyword_color in
		  colorize param buf color k);
	       line
	   | `Newline ->
	       Buffer.add_char buf '\n';
	       if rest <> [] then
		 line_comment param buf line;
	       line + 1
	   | `Tab ->
	       if param.tab_size < 0 then Buffer.add_char buf '\t'
	       else add_string buf (String.make param.tab_size ' ');
	       line
	   | `Start_annot (info, annot) -> line
	   | `Stop_annot info -> line)
      2 l in
  ()


let esc s =
  let buf = Buffer.create (2 * String.length s) in
  for i = 0 to String.length s - 1 do
    match s.[i] with
        '_' | '{' | '}' | '%' | '~' as c -> bprintf buf "\\%c" c
      | '\\' -> bprintf buf "$\\backslash$"
      | c -> Buffer.add_char buf c
  done;
  Buffer.contents buf

let ocaml_file
  ?(filename = "") 
  ?keyword_colors
  ~param
  buf l =
  
  if param.title then
    bprintf buf "\\section{\\tt %s}\n" (esc filename);

  Buffer.add_string buf "\n\\begin{alltt}\n";
  line_comment param buf 1;
  ocaml ?keyword_colors ~param buf l;
  Buffer.add_string buf "\\end{alltt}\n"



let begin_document ?(param = default_param) buf files =
  bprintf buf "\
%% Auto-generated by caml2html %s from %s
\\documentclass{article}
\\usepackage{alltt}
\\usepackage{color}
"
    Version.version (String.concat ", " files);
  bprintf buf "%s\n" param.defs;
  Buffer.add_string buf "\\begin{document}\n"


let end_document ?(param = default_param) buf =
  Buffer.add_string buf "\\end{document}\n"


let handle_file ?keyword_colors ?(param = default_param) buf filename =
  let l = Input.file filename in
  ocaml_file ?keyword_colors ~param ~filename buf l

let rec mkdir_p dir =
  if Sys.file_exists dir then ()
  else
    (mkdir_p (Filename.dirname dir);
     Unix.mkdir dir 0o777)

let save_file ?(dir = "") buf file =
  let dir_res_name =
    if dir = "" then file
    else
      (mkdir_p dir;
       Filename.concat dir file) in
  let chan_out = open_out dir_res_name in
  Buffer.output_buffer chan_out buf;
  close_out chan_out

let ocaml_document ?dir ?keyword_colors ?param files outfile =
  let buf = Buffer.create 50_000 in
  begin_document ?param buf files;
  let rec tmp = function
    | [] -> ()
    | [x] -> handle_file ?keyword_colors ?param buf x
    | x :: l ->
	handle_file ?keyword_colors ?param buf x;
        Buffer.add_string buf "\n\\rule{\\textwidth}{1pt}\n";
        tmp l in
  tmp files;
  end_document ?param buf;
  save_file ?dir buf outfile