Mercurial > urweb

changeset 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
files doc/intro.ur src/tutorial.sml
diffstat 2 files changed, 87 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/doc/intro.ur	Fri Jul 15 16:50:55 2011 -0400
+++ b/doc/intro.ur	Fri Jul 15 17:16:39 2011 -0400
@@ -1,3 +1,5 @@
+(* Introduction *)
+
 (* Test evaluation.... *)
 
 fun f [a] (x : a) : a = x
--- a/src/tutorial.sml	Fri Jul 15 16:50:55 2011 -0400
+++ b/src/tutorial.sml	Fri Jul 15 17:16:39 2011 -0400
@@ -27,7 +27,7 @@
 
 structure Tutorial :> TUTORIAL = struct
 
-fun readAll' inf =
+fun readAll inf =
     let
         fun loop acc =
             case TextIO.inputLine inf of
@@ -38,10 +38,87 @@
         before TextIO.closeIn inf
     end
 
-fun readAll fname = readAll' (TextIO.openIn fname)
+val readAllFile = readAll o TextIO.openIn
+
+fun fixupFile (fname, title) =
+    let
+        val source = readAllFile "/tmp/final.html"
+        val outf = TextIO.openOut (OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
+                                                       path = OS.Path.joinBaseExt {base = OS.Path.base fname, ext = SOME "html"}})
+
+        val (befor, after) = Substring.position "<title>" source
+
+        fun loop source =
+            let
+                val (befor, after) = Substring.position "<span class=\"comment-delimiter\">(* </span><span class=\"comment\">" source
+            in
+                if Substring.isEmpty after then
+                    TextIO.outputSubstr (outf, source)
+                else
+                    let
+                        val (befor', after) = Substring.position " </span><span class=\"comment-delimiter\">*)</span>"
+                                                             (Substring.slice (after, 64, NONE))
+                    in
+                        if Substring.isEmpty after then
+                            TextIO.outputSubstr (outf, source)
+                        else
+                            (TextIO.outputSubstr (outf, befor);
+                             TextIO.output (outf, "<div class=\"prose\">");
+                             TextIO.outputSubstr (outf, befor');
+                             TextIO.output (outf, "</div>");
+                             loop (Substring.slice (after, 49, NONE)))
+                    end
+            end
+    in
+        if Substring.isEmpty after then
+            raise Fail ("Missing <title> for " ^ title)
+        else
+            (TextIO.outputSubstr (outf, befor);
+             TextIO.output (outf, "<style type=\"text/css\">\n");
+             TextIO.output (outf, "<!--\n");
+             TextIO.output (outf, "\tdiv.prose {\n");
+             TextIO.output (outf, "\t\tfont-family: Arial;\n");
+             TextIO.output (outf, "\t\tbackground-color: #CCFFCC;\n");
+             TextIO.output (outf, "\t\tborder-style: solid;\n");
+             TextIO.output (outf, "\t\tpadding: 5px;\n");
+             TextIO.output (outf, "\t\tfont-size: larger;\n");
+             TextIO.output (outf, "\t}\n");
+             TextIO.output (outf, "-->\n");
+             TextIO.output (outf, "</style>\n");
+             TextIO.output (outf, "<title>");
+             TextIO.output (outf, title);
+             let
+                 val (befor, after) = Substring.position "</title>" after
+             in
+                 if Substring.isEmpty after then
+                     raise Fail ("Missing </title> for " ^ title)
+                 else
+                     let
+                         val (befor, after) = Substring.position "<body>" after
+                     in
+                         if Substring.isEmpty after then
+                             raise Fail ("Missing <body> for " ^ title)
+                         else
+                             (TextIO.outputSubstr (outf, befor);
+                              TextIO.output (outf, "<body><h1>");
+                              TextIO.output (outf, title);
+                              TextIO.output (outf, "</h1>");
+                              loop (Substring.slice (after, 6, NONE)))
+                     end
+             end;
+             TextIO.closeOut outf)
+    end
 
 fun doUr fname =
     let
+        val inf = TextIO.openIn fname
+
+        val title = case TextIO.inputLine inf of
+                        NONE => raise Fail ("No title comment at start of " ^ fname)
+                      | SOME title => title
+
+        val title = String.substring (title, 3, size title - 7)
+
         val eval = TextIO.openOut "/tmp/eval.ur"
         val gen = TextIO.openOut "/tmp/gen.ur"
 
@@ -115,11 +192,11 @@
                     end
             end
     in
-        doDirectives (0, readAll fname);
+        doDirectives (0, readAll inf);
         TextIO.closeOut gen;
 
         TextIO.output (eval, "\n\nfun main () : transaction page =\nreturn <xml><body>");
-        TextIO.outputSubstr (eval, readAll "/tmp/gen.ur");
+        TextIO.outputSubstr (eval, readAllFile "/tmp/gen.ur");
         TextIO.output (eval, "</body></xml>");
         TextIO.closeOut eval;
 
@@ -127,7 +204,7 @@
             let
                 val proc = Unix.execute ("/bin/sh", ["-c", "/tmp/eval.exe /main"])
                 val inf = Unix.textInstreamOf proc
-                val s = readAll' inf
+                val s = readAll inf
                 val _ = Unix.reap proc
 
                 val (befor, after) = Substring.position "<sc>" s
@@ -165,15 +242,13 @@
                                           ^ "(urweb-mode) "
                                           ^ "(find-file \\\"/tmp/final.ur\\\") "
                                           ^ "(switch-to-buffer (htmlize-buffer)) "
-                                          ^ "(write-file \\\""
-                                          ^ OS.Path.mkAbsolute {relativeTo = OS.FileSys.getDir (),
-                                                                path = OS.Path.joinBaseExt {base = OS.Path.base fname, ext = SOME "html"}}
-                                          ^ "\\\") "
+                                          ^ "(write-file \\\"/tmp/final.html\\\") "
                                           ^ "(kill-emacs))\""
                             in
                                 eatNls befor;
                                 TextIO.closeOut outf;
-                                ignore (OS.Process.system cmd)
+                                ignore (OS.Process.system cmd);
+                                fixupFile (fname, title)
                             end
                     end
             end