diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index 5a2a55bfd0..f4f30ea33f 100644
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@@ -25,6 +25,19 @@ GENERIC: render* ( value name renderer -- xml )
: render ( name renderer -- )
render>xml write-xml ;
+
+
+: render-string ( name renderer -- )
+ render>xml write-nested ;
+
SINGLETON: label
M: label render*
diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor
index 8003d71d36..780b55462c 100644
--- a/basis/html/templates/chloe/chloe-tests.factor
+++ b/basis/html/templates/chloe/chloe-tests.factor
@@ -5,6 +5,9 @@ splitting furnace accessors
html.templates.chloe.compiler ;
IN: html.templates.chloe.tests
+! So that changes to code are reflected
+[ ] [ reset-cache ] unit-test
+
: run-template ( quot -- string )
with-string-writer [ "\r\n\t" member? not ] filter
"?>" split1 nip ; inline
@@ -170,3 +173,24 @@ TUPLE: person first-name last-name ;
"test13" test-template call-template
] run-template
] [ error>> T{ unknown-chloe-tag f "this-tag-does-not-exist" } = ] must-fail-with
+
+[ "Hello <world> &escaping test;" "Hello &escaping test;" ] [
+ [
+ title set
+ [
+ begin-form
+ "&escaping test;" "a-value" set-value
+ "test14" test-template call-template
+ ] run-template
+ title get box>
+ ] with-scope
+] unit-test
+
+[
+ [
+ title set
+ [
+ "test15" test-template call-template
+ ] run-template
+ ] with-scope
+] [ error>> tag-not-allowed-here? ] must-fail-with
diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index 92e4a8dc49..921cdcc8ae 100644
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -70,7 +70,15 @@ DEFER: compile-element
name>string [write]
">" [write] ;
+SYMBOL: string-context?
+
+ERROR: tag-not-allowed-here ;
+
+: check-tag ( -- )
+ string-context? get [ tag-not-allowed-here ] when ;
+
: compile-tag ( tag -- )
+ check-tag
{
[ main>> tag-stack get push ]
[ compile-start-tag ]
@@ -87,13 +95,20 @@ ERROR: unknown-chloe-tag tag ;
[ unknown-chloe-tag ]
?if ;
+: compile-string ( string -- )
+ string-context? get [ escape-string ] unless [write] ;
+
+: compile-misc ( object -- )
+ check-tag
+ [ write-xml ] [code-with] ;
+
: compile-element ( element -- )
{
{ [ dup chloe-tag? ] [ compile-chloe-tag ] }
{ [ dup [ tag? ] [ xml? ] bi or ] [ compile-tag ] }
- { [ dup string? ] [ escape-string [write] ] }
+ { [ dup string? ] [ compile-string ] }
{ [ dup comment? ] [ drop ] }
- [ [ write-xml ] [code-with] ]
+ [ compile-misc ]
} cond ;
: with-compiler ( quot -- quot' )
@@ -119,7 +134,9 @@ ERROR: unknown-chloe-tag tag ;
[ [ compile-children ] compile-quot ] [ % ] bi* ; inline
: compile-children>string ( tag -- )
- [ with-string-writer ] process-children ;
+ t string-context? [
+ [ with-string-writer ] process-children
+ ] with-variable ;
: compile-with-scope ( quot -- )
compile-quot [ with-scope ] [code] ; inline
diff --git a/basis/html/templates/chloe/components/components.factor b/basis/html/templates/chloe/components/components.factor
index d69dc08537..3c1446b060 100644
--- a/basis/html/templates/chloe/components/components.factor
+++ b/basis/html/templates/chloe/components/components.factor
@@ -1,17 +1,23 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sequences kernel parser fry quotations
-classes.tuple classes.singleton
+classes.tuple classes.singleton namespaces
html.components
html.templates.chloe.compiler
html.templates.chloe.syntax ;
IN: html.templates.chloe.components
-
+
+: render-quot ( -- quot )
+ string-context? get
+ [ render-string ]
+ [ render ]
+ ? ;
+
GENERIC: component-tag ( tag class -- )
M: singleton-class component-tag ( tag class -- )
[ "name" required-attr compile-attr ]
- [ literalize [ render ] [code-with] ]
+ [ literalize render-quot [code-with] ]
bi* ;
: compile-component-attrs ( tag class -- )
@@ -23,7 +29,7 @@ M: singleton-class component-tag ( tag class -- )
M: tuple-class component-tag ( tag class -- )
[ drop "name" required-attr compile-attr ]
[ compile-component-attrs ] 2bi
- [ render ] [code] ;
+ render-quot [code] ;
SYNTAX: COMPONENT:
scan-word
diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor
index aebae701ed..fd48d81ecd 100644
--- a/basis/html/templates/templates.factor
+++ b/basis/html/templates/templates.factor
@@ -29,13 +29,20 @@ M: template-error error.
: call-template ( template -- )
[ call-template* ] [ \ template-error boa rethrow ] recover ;
+ERROR: no-boilerplate ;
+
+M: no-boilerplate error.
+ drop
+ "get-title and set-title can only be used from within" print
+ "a with-boilerplate form" print ;
+
SYMBOL: title
: set-title ( string -- )
- title get >box ;
+ title get [ >box ] [ no-boilerplate ] if* ;
: get-title ( -- string )
- title get value>> ;
+ title get [ value>> ] [ no-boilerplate ] if* ;
: write-title ( -- )
get-title write ;