diff options
| -rw-r--r-- | doc/manual.tex | 5 | ||||
| -rw-r--r-- | lib/ur/basis.urs | 2 | ||||
| -rw-r--r-- | src/monoize.sml | 6 | ||||
| -rw-r--r-- | src/urweb.grm | 15 | ||||
| -rw-r--r-- | tests/css.ur | 4 |
5 files changed, 23 insertions, 9 deletions
diff --git a/doc/manual.tex b/doc/manual.tex index 1976199d..532e0ea9 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -1954,13 +1954,13 @@ $$\begin{array}{l} \mt{val} \; \mt{tag} : \mt{attrsGiven} ::: \{\mt{Type}\} \to \mt{attrsAbsent} ::: \{\mt{Type}\} \to \mt{ctxOuter} ::: \{\mt{Unit}\} \to \mt{ctxInner} ::: \{\mt{Unit}\} \\ \hspace{.1in} \to \mt{useOuter} ::: \{\mt{Type}\} \to \mt{useInner} ::: \{\mt{Type}\} \to \mt{bindOuter} ::: \{\mt{Type}\} \to \mt{bindInner} ::: \{\mt{Type}\} \\ \hspace{.1in} \to [\mt{attrsGiven} \sim \mt{attrsAbsent}] \Rightarrow [\mt{useOuter} \sim \mt{useInner}] \Rightarrow [\mt{bindOuter} \sim \mt{bindInner}] \\ - \hspace{.1in} \Rightarrow \mt{option} \; \mt{css\_class} \\ + \hspace{.1in} \Rightarrow \mt{css\_class} \\ \hspace{.1in} \to \mt{option} \; (\mt{signal} \; \mt{css\_class}) \\ \hspace{.1in} \to \$\mt{attrsGiven} \\ \hspace{.1in} \to \mt{tag} \; (\mt{attrsGiven} \rc \mt{attrsAbsent}) \; \mt{ctxOuter} \; \mt{ctxInner} \; \mt{useOuter} \; \mt{bindOuter} \\ \hspace{.1in} \to \mt{xml} \; \mt{ctxInner} \; \mt{useInner} \; \mt{bindInner} \to \mt{xml} \; \mt{ctxOuter} \; (\mt{useOuter} \rc \mt{useInner}) \; (\mt{bindOuter} \rc \mt{bindInner}) \end{array}$$ -Note that any tag may be assigned a CSS class. This is the sole way of making use of the values produced by $\mt{style}$ declarations. Ur/Web itself doesn't deal with the syntax or semantics of style sheets; they can be linked via URLs with \texttt{link} tags. However, Ur/Web does make it easy to calculate upper bounds on usage of CSS classes through program analysis. The function $\mt{Basis.classes}$ can be used to specify a list of CSS classes for a single tag. +Note that any tag may be assigned a CSS class, or left without a class by passing $\mt{Basis.null}$ as the first value-level argument. This is the sole way of making use of the values produced by $\mt{style}$ declarations. Ur/Web itself doesn't deal with the syntax or semantics of style sheets; they can be linked via URLs with \texttt{link} tags. However, Ur/Web does make it easy to calculate upper bounds on usage of CSS classes through program analysis. The function $\mt{Basis.classes}$ can be used to specify a list of CSS classes for a single tag. Also note that two different arguments are available for setting CSS classes: the first, associated with the \texttt{class} pseudo-attribute syntactic sugar, fixes the class of a tag for the duration of the tag's life; while the second, associated with the \texttt{dynClass} pseudo-attribute, allows the class to vary over the tag's life. See Section \ref{signals} for an introduction to the $\mt{signal}$ type family. @@ -2234,6 +2234,7 @@ $$\begin{array}{rrcll} &&& \{e\} & \textrm{computed value} \\ \end{array}$$ +Further, there is a special convenience and compatibility form for setting CSS classes of tags. If a \cd{class} attribute has a value that is a string literal, the literal is parsed in the usual HTML way and replaced with calls to appropriate Ur/Web combinators. Any dashes in the text are replaced with underscores to determine Ur identifiers. \section{\label{structure}The Structure of Web Applications} diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 2869adce..ef2b9156 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -648,7 +648,7 @@ val tag : attrsGiven ::: {Type} -> attrsAbsent ::: {Type} -> [attrsGiven ~ attrsAbsent] => [useOuter ~ useInner] => [bindOuter ~ bindInner] => - option css_class + css_class -> option (signal css_class) -> $attrsGiven -> tag (attrsGiven ++ attrsAbsent) diff --git a/src/monoize.sml b/src/monoize.sml index 6bef134e..1b7018de 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3077,15 +3077,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc) val s = (L'.ECase (class, - [((L'.PNone t, loc), + [((L'.PPrim (Prim.String ""), loc), s), - ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc), + ((L'.PVar ("x", t), loc), (L'.EStrcat (s, (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc), (L'.EStrcat ((L'.ERel 0, loc), (L'.EPrim (Prim.String "\""), loc)), loc)), loc)), loc))], - {disc = (L'.TOption t, loc), + {disc = t, result = t}), loc) val (s, fm) = foldl (fn (("Action", _, _), acc) => acc diff --git a/src/urweb.grm b/src/urweb.grm index 0fe9b987..6d175c48 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -246,6 +246,15 @@ fun tnamesOf (e, _) = | EDisjointApp e => tnamesOf e | _ => [] +fun classOut (s, pos) = (EVar ([], String.translate (fn #"-" => "_" | ch => str ch) s, Infer), pos) + +fun parseClass s pos = + case String.tokens Char.isSpace s of + [] => (EVar (["Basis"], "null", Infer), pos) + | class :: classes => + foldl (fn (s, e) => (EApp ((EApp ((EVar (["Basis"], "classes", Infer), pos), e), pos), classOut (s, pos)), pos)) + (classOut (class, pos)) classes + %% %header (functor UrwebLrValsFn(structure Token : TOKEN)) @@ -1521,9 +1530,9 @@ tag : tagHead attrs (let val e = (EVar (["Basis"], "tag", Infer), pos) val eo = case #1 attrs of - NONE => (EVar (["Basis"], "None", Infer), pos) - | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos), - e), pos) + NONE => (EVar (["Basis"], "null", Infer), pos) + | SOME (EPrim (Prim.String s), pos) => parseClass s pos + | SOME e => e val e = (EApp (e, eo), pos) val eo = case #2 attrs of NONE => (EVar (["Basis"], "None", Infer), pos) diff --git a/tests/css.ur b/tests/css.ur index 4218aaae..04d3a701 100644 --- a/tests/css.ur +++ b/tests/css.ur @@ -1,6 +1,10 @@ style st1 style st2 +style st_3 fun main () = return <xml><body> <span title="Whoa" class={classes st1 st2}>Hi!</span> + <span class="st-3 st2">Bye!</span> + <span class="st1">Appendix!</span> + <span class="">Sequel!</span> </body></xml> |