Assorted fixes

db4
Slava Pestov 2008-09-08 02:52:42 -05:00
parent 1bcb041561
commit d470bde42b
5 changed files with 46 additions and 24 deletions

View File

@ -65,7 +65,10 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
: a-end-tag ( tag -- ) : a-end-tag ( tag -- )
drop [ </a> ] [code] ; drop [ </a> ] [code] ;
CHLOE: a [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri ; CHLOE: a
[
[ a-start-tag ] [ compile-children ] [ a-end-tag ] tri
] compile-with-scope ;
: compile-hidden-form-fields ( for -- ) : compile-hidden-form-fields ( for -- )
'[ '[
@ -95,12 +98,14 @@ CHLOE: a [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri ;
drop [ </form> ] [code] ; drop [ </form> ] [code] ;
CHLOE: form CHLOE: form
[
{ {
[ compile-link-attrs ] [ compile-link-attrs ]
[ form-start-tag ] [ form-start-tag ]
[ compile-children ] [ compile-children ]
[ form-end-tag ] [ form-end-tag ]
} cleave ; } cleave
] compile-with-scope ;
STRING: button-tag-markup STRING: button-tag-markup
<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0"> <t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">

View File

@ -88,13 +88,21 @@ CHLOE-TUPLE: choice
CHLOE-TUPLE: checkbox CHLOE-TUPLE: checkbox
CHLOE-TUPLE: code CHLOE-TUPLE: code
MEMO: template-quot ( chloe -- quot ) : read-template ( chloe -- xml )
path>> ".xml" append utf8 <file-reader> read-xml path>> ".xml" append utf8 <file-reader> read-xml ;
compile-template ;
: reset-templates ( -- ) \ template-quot reset-memoized ; MEMO: template-quot ( chloe -- quot )
read-template compile-template ;
MEMO: nested-template-quot ( chloe -- quot )
read-template compile-nested-template ;
: reset-templates ( -- )
{ template-quot nested-template-quot } [ reset-memoized ] each ;
M: chloe call-template* M: chloe call-template*
template-quot call ; nested-template? get
[ nested-template-quot ] [ template-quot ] if
assert-depth ;
INSTANCE: chloe template INSTANCE: chloe template

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs namespaces kernel sequences accessors combinators USING: assocs namespaces kernel sequences accessors combinators
strings splitting io io.streams.string xml.writer xml.data strings splitting io io.streams.string present xml.writer
xml.entities html.forms html.templates.chloe.syntax ; xml.data xml.entities html.forms html.templates.chloe.syntax ;
IN: html.templates.chloe.compiler IN: html.templates.chloe.compiler
: chloe-attrs-only ( assoc -- assoc' ) : chloe-attrs-only ( assoc -- assoc' )
@ -42,10 +42,10 @@ DEFER: compile-element
reset-buffer [ , ] [ % ] bi* ; reset-buffer [ , ] [ % ] bi* ;
: expand-attr ( value -- ) : expand-attr ( value -- )
[ value write ] [code-with] ; [ value present write ] [code-with] ;
: compile-attr ( value -- ) : compile-attr ( value -- )
reset-buffer "@" ?head [ , \ value ] when , ; reset-buffer "@" ?head [ , [ value present ] % ] [ , ] if ;
: compile-attrs ( assoc -- ) : compile-attrs ( assoc -- )
[ [
@ -103,19 +103,23 @@ DEFER: compile-element
: compile-chunk ( seq -- ) : compile-chunk ( seq -- )
[ compile-element ] each ; [ compile-element ] each ;
: process-children ( tag quot -- ) : compile-quot ( quot -- )
reset-buffer reset-buffer
[
[ [
SBUF" " string-buffer set SBUF" " string-buffer set
compile-children call
reset-buffer reset-buffer
] [ ] make , ] [ ] make , ; inline
] [ % ] bi* ;
: process-children ( tag quot -- )
[ [ compile-children ] compile-quot ] [ % ] bi* ; inline
: compile-children>string ( tag -- ) : compile-children>string ( tag -- )
[ with-string-writer ] process-children ; [ with-string-writer ] process-children ;
: compile-with-scope ( quot -- )
compile-quot [ with-scope ] [code] ; inline
: compile-template ( xml -- quot ) : compile-template ( xml -- quot )
[ [
{ {

View File

@ -0,0 +1,5 @@
IN: xml.writer.tests
USING: xml.data xml.writer tools.test ;
[ "foo" ] [ T{ name { main "foo" } } name>string ] unit-test
[ "ns:foo" ] [ T{ name { space "ns" } { main "foo" } } name>string ] unit-test

View File

@ -38,7 +38,7 @@ SYMBOL: indenter
] when ; ] when ;
: name>string ( name -- string ) : name>string ( name -- string )
[ main>> ] [ space>> ] bi [ ":" swap 3append ] unless-empty ; [ main>> ] [ space>> ] bi [ ":" rot 3append ] unless-empty ;
: print-name ( name -- ) : print-name ( name -- )
name>string write ; name>string write ;