: render ( name renderer -- )
render>xml write-xml ;
+<PRIVATE
+
+GENERIC: write-nested ( obj -- )
+
+M: string write-nested write ;
+
+M: sequence write-nested [ write-nested ] each ;
+
+PRIVATE>
+
+: render-string ( name renderer -- )
+ render>xml write-nested ;
+
SINGLETON: label
M: label render*
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
"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 <world> &escaping test;" ] [
+ [
+ <box> title set
+ [
+ begin-form
+ "&escaping test;" "a-value" set-value
+ "test14" test-template call-template
+ ] run-template
+ title get box>
+ ] with-scope
+] unit-test
+
+[
+ [
+ <box> title set
+ [
+ "test15" test-template call-template
+ ] run-template
+ ] with-scope
+] [ error>> tag-not-allowed-here? ] must-fail-with
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 ]
[ 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' )
[ [ 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
-! 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 -- )
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
: 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 ;