1:
2:
3:
4: {
5:
6: let () =
7: if Array.length Sys.argv <> 2
8: || not (Sys.file_exists Sys.argv.(1)) then begin
9: Printf.eprintf "usage: caml2html file\n";
10: exit 1
11: end
12:
13:
14: let file = Sys.argv.(1)
15: let cout = open_out (file ^ ".html")
16: let print s = Printf.fprintf cout s
17:
18:
19: let () =
20: print "<html><head><title>%s</title><style>" file;
21: print ".keyword { color: green; } .comment { color: #990000; } .number { color: black; }";
22: print "</style></head><body><pre>"
23:
24:
25: let count = ref 0
26: let newline () = incr count; print "\n<span class=\"number\">%3d</span>: " !count
27: let () = newline ()
28:
29:
30: let is_keyword =
31: let ht = Hashtbl.create 97 in
32: List.iter
33: (fun s -> Hashtbl.add ht s ())
34: [ "and"; "as"; "assert"; "asr"; "begin"; "class";
35: "closed"; "constraint"; "do"; "done"; "downto"; "else";
36: "end"; "exception"; "external"; "false"; "for"; "fun";
37: "function"; "functor"; "if"; "in"; "include"; "inherit";
38: "land"; "lazy"; "let"; "lor"; "lsl"; "lsr";
39: "lxor"; "match"; "method"; "mod"; "module"; "mutable";
40: "new"; "of"; "open"; "or"; "parser"; "private";
41: "rec"; "sig"; "struct"; "then"; "to"; "true";
42: "try"; "type"; "val"; "virtual"; "when"; "while";
43: "with" ];
44: fun s -> Hashtbl.mem ht s
45:
46: }
47:
48:
49:
50: let ident = ['A'-'Z' 'a'-'z' '_'] ['A'-'Z' 'a'-'z' '0'-'9' '_']*
51:
52:
53:
54: rule scan = parse
55: | "(*" { print "<span class=\"comment\">(*";
56: comment lexbuf;
57: print "</span>";
58: scan lexbuf }
59: | eof { () }
60: | ident as s
61: { if is_keyword s then begin
62: print "<span class=\"keyword\">%s</span>" s
63: end else
64: print "%s" s;
65: scan lexbuf }
66: | "<" { print "<"; scan lexbuf }
67: | "&" { print "&"; scan lexbuf }
68: | "\n" { newline (); scan lexbuf }
69: | '"' { print "\""; string lexbuf; scan lexbuf }
70: | "'\"'"
71: | _ as s { print "%s" s; scan lexbuf }
72:
73:
74:
75: and comment = parse
76: | "(*" { print "(*"; comment lexbuf; comment lexbuf }
77: | "*)" { print "*)" }
78: | eof { () }
79: | "\n" { newline (); comment lexbuf }
80: | '"' { print "\""; string lexbuf; comment lexbuf }
81: | "<" { print "<"; comment lexbuf }
82: | "&" { print "&"; comment lexbuf }
83: | "'\"'"
84: | _ as s { print "%s" s; comment lexbuf }
85:
86: and string = parse
87: | '"' { print "\"" }
88: | "<" { print "<"; string lexbuf }
89: | "&" { print "&"; string lexbuf }
90: | "\\" _
91: | _ as s { print "%s" s; string lexbuf }
92:
93: {
94:
95:
97: let () =
98: scan (Lexing.from_channel (open_in file));
99: print "</pre>\n</body></html>\n";
100: close_out cout
101:
102: }
103: