changeset 724:12ec14a6be0b

<link>
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Apr 2009 12:00:44 -0400
parents 311ca1ae715d
children 4c5796512edc
files lib/ur/basis.urs src/monoize.sml src/urweb.grm tests/style.ur
diffstat 4 files changed, 36 insertions(+), 18 deletions(-) [+]
line wrap: on
line diff
--- a/lib/ur/basis.urs	Mon Apr 13 08:44:32 2009 -0400
+++ b/lib/ur/basis.urs	Thu Apr 16 12:00:44 2009 -0400
@@ -452,11 +452,15 @@
 con tabl = [Body, Table]
 con tr = [Body, Tr]
 
+type url
+val bless : string -> url
+
 val dyn : use ::: {Type} -> bind ::: {Type} -> unit
           -> tag [Signal = signal (xml body use bind)] body [] use bind
 
 val head : unit -> tag [] html head [] []
 val title : unit -> tag [] head [] [] []
+val link : unit -> tag [Rel = string, Typ = string, Href = url, Media = string] head [] [] []
 
 val body : unit -> tag [Onload = transaction unit] html body [] []
 con bodyTag = fn (attrs :: {Type}) =>
@@ -489,8 +493,6 @@
 
 val hr : bodyTag []
 
-type url
-val bless : string -> url
 val a : bodyTag [Link = transaction page, Href = url, Onclick = transaction unit]
 
 val img : bodyTag [Src = url]
--- a/src/monoize.sml	Mon Apr 13 08:44:32 2009 -0400
+++ b/src/monoize.sml	Thu Apr 16 12:00:44 2009 -0400
@@ -2168,6 +2168,10 @@
                                                 | "Action" => urlifyExp
                                                 | _ => attrifyExp
 
+                                          val x =
+                                              case x of
+                                                  "Typ" => "Type"
+                                                | _ => x
                                           val xp = " " ^ lowercaseFirst x ^ "=\""
 
                                           val (e, fm) = fooify env fm (e, t)
--- a/src/urweb.grm	Mon Apr 13 08:44:32 2009 -0400
+++ b/src/urweb.grm	Thu Apr 16 12:00:44 2009 -0400
@@ -1308,19 +1308,26 @@
 attr   : SYMBOL EQ attrv                (if SYMBOL = "class" then
                                              Class attrv
                                          else
-                                             Normal ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
-                                                     if (SYMBOL = "href" orelse SYMBOL = "src")
-                                                        andalso (case #1 attrv of
-                                                                     EPrim _ => true
-                                                                   | _ => false) then
-                                                         let
-                                                             val loc = s (attrvleft, attrvright)
-                                                         in
-                                                             (EApp ((EVar (["Basis"], "bless", Infer), loc),
-                                                                    attrv), loc)
-                                                         end
-                                                     else
-                                                         attrv))
+                                             let
+                                                 val sym =
+                                                     case SYMBOL of
+                                                         "type" => "Typ"
+                                                       | x => capitalize x
+                                             in
+                                                 Normal ((CName sym, s (SYMBOLleft, SYMBOLright)),
+                                                         if (sym = "Href" orelse sym = "Src")
+                                                            andalso (case #1 attrv of
+                                                                         EPrim _ => true
+                                                                       | _ => false) then
+                                                             let
+                                                                 val loc = s (attrvleft, attrvright)
+                                                             in
+                                                                 (EApp ((EVar (["Basis"], "bless", Infer), loc),
+                                                                        attrv), loc)
+                                                             end
+                                                         else
+                                                             attrv)
+                                             end)
                 
 attrv  : INT                            (EPrim (Prim.Int INT), s (INTleft, INTright))
        | FLOAT                          (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
--- a/tests/style.ur	Mon Apr 13 08:44:32 2009 -0400
+++ b/tests/style.ur	Thu Apr 16 12:00:44 2009 -0400
@@ -1,6 +1,11 @@
 style q
 style r
 
-fun main () : transaction page = return <xml><body>
-  Hi.  <span class={q}>And hi <span class={r}>again</span>!</span>
-</body></xml>
+fun main () : transaction page = return <xml>
+  <head>
+    <link rel="stylesheet" type="text/css" href="http://www.schizomaniac.net/style.css" media="screen"/>
+  </head>
+  <body>
+    Hi.  <span class={q}>And hi <span class={r}>again</span>!</span>
+  </body>
+</xml>