Mercurial > urweb

comparison src/tutorial.sml @ 1494:9ef6dd0df7a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Beautified tutorial HTML
author Adam Chlipala <adam@chlipala.net>
date Fri, 15 Jul 2011 17:16:39 -0400
parents 9cb923efea4d
children af0d4d11c5d7
comparison
equal deleted inserted replaced
1493:9cb923efea4d 1494:9ef6dd0df7a0
25 * POSSIBILITY OF SUCH DAMAGE. 25 * POSSIBILITY OF SUCH DAMAGE.
26 *) 26 *)
27 27
28 structure Tutorial :> TUTORIAL = struct 28 structure Tutorial :> TUTORIAL = struct
29 29
30 fun readAll' inf = 30 fun readAll inf =
31 let 31 let
32 fun loop acc = 32 fun loop acc =
33 case TextIO.inputLine inf of 33 case TextIO.inputLine inf of
34 NONE => Substring.full (String.concat (rev acc)) 34 NONE => Substring.full (String.concat (rev acc))
35 | SOME line => loop (line :: acc) 35 | SOME line => loop (line :: acc)
36 in 36 in
37 loop [] 37 loop []
38 before TextIO.closeIn inf 38 before TextIO.closeIn inf
39 end 39 end
40 40
41 fun readAll fname = readAll' (TextIO.openIn fname) 41 val readAllFile = readAll o TextIO.openIn
42
43 fun fixupFile (fname, title) =
44 let
45 val source = readAllFile "/tmp/final.html"
46 val outf = TextIO.openOut (OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
47 path = OS.Path.joinBaseExt {base = OS.Path.base fname, ext = SOME "html"}})
48
49 val (befor, after) = Substring.position "<title>" source
50
51 fun loop source =
52 let
53 val (befor, after) = Substring.position "<span class=\"comment-delimiter\">(* </span><span class=\"comment\">" source
54 in
55 if Substring.isEmpty after then
56 TextIO.outputSubstr (outf, source)
57 else
58 let
59 val (befor', after) = Substring.position " </span><span class=\"comment-delimiter\">*)</span>"
60 (Substring.slice (after, 64, NONE))
61 in
62 if Substring.isEmpty after then
63 TextIO.outputSubstr (outf, source)
64 else
65 (TextIO.outputSubstr (outf, befor);
66 TextIO.output (outf, "<div class=\"prose\">");
67 TextIO.outputSubstr (outf, befor');
68 TextIO.output (outf, "</div>");
69 loop (Substring.slice (after, 49, NONE)))
70 end
71 end
72 in
73 if Substring.isEmpty after then
74 raise Fail ("Missing <title> for " ^ title)
75 else
76 (TextIO.outputSubstr (outf, befor);
77 TextIO.output (outf, "<style type=\"text/css\">\n");
78 TextIO.output (outf, "<!--\n");
79 TextIO.output (outf, "\tdiv.prose {\n");
80 TextIO.output (outf, "\t\tfont-family: Arial;\n");
81 TextIO.output (outf, "\t\tbackground-color: #CCFFCC;\n");
82 TextIO.output (outf, "\t\tborder-style: solid;\n");
83 TextIO.output (outf, "\t\tpadding: 5px;\n");
84 TextIO.output (outf, "\t\tfont-size: larger;\n");
85 TextIO.output (outf, "\t}\n");
86 TextIO.output (outf, "-->\n");
87 TextIO.output (outf, "</style>\n");
88 TextIO.output (outf, "<title>");
89 TextIO.output (outf, title);
90 let
91 val (befor, after) = Substring.position "</title>" after
92 in
93 if Substring.isEmpty after then
94 raise Fail ("Missing </title> for " ^ title)
95 else
96 let
97 val (befor, after) = Substring.position "<body>" after
98 in
99 if Substring.isEmpty after then
100 raise Fail ("Missing <body> for " ^ title)
101 else
102 (TextIO.outputSubstr (outf, befor);
103 TextIO.output (outf, "<body><h1>");
104 TextIO.output (outf, title);
105 TextIO.output (outf, "</h1>");
106 loop (Substring.slice (after, 6, NONE)))
107 end
108 end;
109 TextIO.closeOut outf)
110 end
42 111
43 fun doUr fname = 112 fun doUr fname =
44 let 113 let
114 val inf = TextIO.openIn fname
115
116 val title = case TextIO.inputLine inf of
117 NONE => raise Fail ("No title comment at start of " ^ fname)
118 | SOME title => title
119
120 val title = String.substring (title, 3, size title - 7)
121
45 val eval = TextIO.openOut "/tmp/eval.ur" 122 val eval = TextIO.openOut "/tmp/eval.ur"
46 val gen = TextIO.openOut "/tmp/gen.ur" 123 val gen = TextIO.openOut "/tmp/gen.ur"
47 124
48 fun untilEnd source = 125 fun untilEnd source =
49 let 126 let
113 end 190 end
114 end 191 end
115 end 192 end
116 end 193 end
117 in 194 in
118 doDirectives (0, readAll fname); 195 doDirectives (0, readAll inf);
119 TextIO.closeOut gen; 196 TextIO.closeOut gen;
120 197
121 TextIO.output (eval, "\n\nfun main () : transaction page =\nreturn <xml><body>"); 198 TextIO.output (eval, "\n\nfun main () : transaction page =\nreturn <xml><body>");
122 TextIO.outputSubstr (eval, readAll "/tmp/gen.ur"); 199 TextIO.outputSubstr (eval, readAllFile "/tmp/gen.ur");
123 TextIO.output (eval, "</body></xml>"); 200 TextIO.output (eval, "</body></xml>");
124 TextIO.closeOut eval; 201 TextIO.closeOut eval;
125 202
126 if Compiler.compile "/tmp/eval" then 203 if Compiler.compile "/tmp/eval" then
127 let 204 let
128 val proc = Unix.execute ("/bin/sh", ["-c", "/tmp/eval.exe /main"]) 205 val proc = Unix.execute ("/bin/sh", ["-c", "/tmp/eval.exe /main"])
129 val inf = Unix.textInstreamOf proc 206 val inf = Unix.textInstreamOf proc
130 val s = readAll' inf 207 val s = readAll inf
131 val _ = Unix.reap proc 208 val _ = Unix.reap proc
132 209
133 val (befor, after) = Substring.position "<sc>" s 210 val (befor, after) = Substring.position "<sc>" s
134 in 211 in
135 if Substring.isEmpty after then 212 if Substring.isEmpty after then
163 ^ "/\\\") " 240 ^ "/\\\") "
164 ^ "(load \\\"urweb-mode-startup\\\") " 241 ^ "(load \\\"urweb-mode-startup\\\") "
165 ^ "(urweb-mode) " 242 ^ "(urweb-mode) "
166 ^ "(find-file \\\"/tmp/final.ur\\\") " 243 ^ "(find-file \\\"/tmp/final.ur\\\") "
167 ^ "(switch-to-buffer (htmlize-buffer)) " 244 ^ "(switch-to-buffer (htmlize-buffer)) "
168 ^ "(write-file \\\"" 245 ^ "(write-file \\\"/tmp/final.html\\\") "
169 ^ OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
170 path = OS.Path.joinBaseExt {base = OS.Path.base fname, ext = SOME "html"}}
171 ^ "\\\") "
172 ^ "(kill-emacs))\"" 246 ^ "(kill-emacs))\""
173 in 247 in
174 eatNls befor; 248 eatNls befor;
175 TextIO.closeOut outf; 249 TextIO.closeOut outf;
176 ignore (OS.Process.system cmd) 250 ignore (OS.Process.system cmd);
251 fixupFile (fname, title)
177 end 252 end
178 end 253 end
179 end 254 end
180 else 255 else
181 () 256 ()