# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1216316036 14400
# Node ID b1cfe49ce6927ded66d4c6191986f973cf8d0f74
# Parent  18299126a343909ce7fb0e2f0c800f5d7a8e6933
Proper escaping of cdata

diff -r 18299126a343 -r b1cfe49ce692 include/lacweb.h
--- a/include/lacweb.h	Thu Jul 17 13:12:16 2008 -0400
+++ b/include/lacweb.h	Thu Jul 17 13:33:56 2008 -0400
@@ -13,6 +13,9 @@
 void lw_write(lw_context, const char*);
 
 
+char *lw_Basis_htmlifyString(lw_Basis_string);
+void lw_Basis_htmlifyString_w(lw_context, lw_Basis_string);
+
 char *lw_Basis_attrifyInt(lw_Basis_int);
 char *lw_Basis_attrifyFloat(lw_Basis_float);
 char *lw_Basis_attrifyString(lw_Basis_string);
diff -r 18299126a343 -r b1cfe49ce692 src/c/lacweb.c
--- a/src/c/lacweb.c	Thu Jul 17 13:12:16 2008 -0400
+++ b/src/c/lacweb.c	Thu Jul 17 13:33:56 2008 -0400
@@ -72,6 +72,7 @@
   lw_write_unsafe(ctx, s);
 }
 
+
 char *lw_Basis_attrifyInt(lw_Basis_int n) {
   return "0";
 }
@@ -207,3 +208,33 @@
 lw_Basis_string lw_unurlifyString(char **s) {
   return "";
 }
+
+
+char *lw_Basis_htmlifyString(lw_Basis_string s) {
+  return "";
+}
+
+void lw_Basis_htmlifyString_w(lw_context ctx, lw_Basis_string s) {
+  lw_check(ctx, strlen(s) * 5);
+
+  for (; *s; s++) {
+    char c = *s;
+
+    switch (c) {
+    case '<':
+      lw_write_unsafe(ctx, "&lt;");
+      break;
+    case '&':
+      lw_write_unsafe(ctx, "&amp;");
+      break;
+    default:
+      if (isprint(c))
+        lw_writec_unsafe(ctx, c);
+      else {
+        lw_write_unsafe(ctx, "&#");
+        lw_Basis_attrifyInt_w_unsafe(ctx, c);
+        lw_writec_unsafe(ctx, ';');
+      }
+    }
+  }
+}
diff -r 18299126a343 -r b1cfe49ce692 src/compiler.sml
--- a/src/compiler.sml	Thu Jul 17 13:12:16 2008 -0400
+++ b/src/compiler.sml	Thu Jul 17 13:33:56 2008 -0400
@@ -51,7 +51,8 @@
         val () = TextIO.closeOut outf
 
         val () = (ErrorMsg.resetErrors ();
-                  ErrorMsg.resetPositioning filename)
+                  ErrorMsg.resetPositioning filename;
+                  Lex.UserDeclarations.initialize ())
 	val file = TextIO.openIn fname
 	fun get _ = TextIO.input file
 	fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
@@ -79,7 +80,8 @@
 fun parseLac filename =
     let
         val () = (ErrorMsg.resetErrors ();
-                  ErrorMsg.resetPositioning filename)
+                  ErrorMsg.resetPositioning filename;
+                  Lex.UserDeclarations.initialize ())
 	val file = TextIO.openIn filename
 	fun get _ = TextIO.input file
 	fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
diff -r 18299126a343 -r b1cfe49ce692 src/mono_opt.sml
--- a/src/mono_opt.sml	Thu Jul 17 13:12:16 2008 -0400
+++ b/src/mono_opt.sml	Thu Jul 17 13:33:56 2008 -0400
@@ -46,6 +46,7 @@
         Real.toString n
 
 val attrifyString = String.translate (fn #"\"" => "&quot;"
+                                       | #"&" => "&amp;"
                                        | ch => if Char.isPrint ch then
                                                    str ch
                                                else
@@ -54,6 +55,15 @@
 val urlifyInt = attrifyInt
 val urlifyFloat = attrifyFloat
 
+val htmlifyString = String.translate (fn ch => case ch of
+                                                   #"<" => "&lt;"
+                                                 | #"&" => "&amp;"
+                                                 | _ =>   
+                                                   if Char.isPrint ch orelse Char.isSpace ch then
+                                                       str ch
+                                                   else
+                                                       "&#" ^ Int.toString (ord ch) ^ ";")
+
 fun hexIt ch =
     let
         val s = Int.fmt StringCvt.HEX (ord ch)
@@ -122,6 +132,13 @@
         ESeq ((optExp (EWrite e1, loc), loc),
               (optExp (EWrite e2, loc), loc))
 
+      | EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]) =>
+        EPrim (Prim.String (htmlifyString s))
+      | EWrite (EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]), loc) =>
+        EWrite (EPrim (Prim.String (htmlifyString s)), loc)
+      | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) =>
+        EFfiApp ("Basis", "htmlifyString_w", [e])
+
       | EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]) =>
         EPrim (Prim.String (attrifyInt n))
       | EWrite (EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]), loc) =>
diff -r 18299126a343 -r b1cfe49ce692 src/monoize.sml
--- a/src/monoize.sml	Thu Jul 17 13:12:16 2008 -0400
+++ b/src/monoize.sml	Thu Jul 17 13:33:56 2008 -0400
@@ -139,7 +139,7 @@
           | L.EFfiApp (m, x, es) => (L'.EFfiApp (m, x, map (monoExp env) es), loc)
 
           | L.EApp ((L.ECApp ((L.EFfi ("Basis", "cdata"), _),
-                              _), _), se) => monoExp env se
+                              _), _), se) => (L'.EFfiApp ("Basis", "htmlifyString", [monoExp env se]), loc)
           | L.EApp (
             (L.EApp (
              (L.ECApp (
diff -r 18299126a343 -r b1cfe49ce692 tests/cdataF.lac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cdataF.lac	Thu Jul 17 13:33:56 2008 -0400
@@ -0,0 +1,8 @@
+val snippet = fn s => <body>
+        <h1>{cdata s}</h1>
+</body>
+
+val main = fn () => <html><body>
+        {snippet "<Hi."}
+        {snippet "Bye."}
+</body></html>