steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Un-breaking Chloe

db4
Daniel Ehrenberg 2009-01-28 17:49:21 -06:00
parent 915be761be
commit dcad3ad225
2 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/html/templates/chloe/compiler/compiler.factor
View File

@ -7,16 +7,16 @@ html.templates html.templates.chloe.syntax continuations ;
IN: html.templates.chloe.compiler IN: html.templates.chloe.compiler
: chloe-attrs-only ( assoc -- assoc' ) : chloe-attrs-only ( assoc -- assoc' )
[ drop url>> chloe-ns = ] assoc-filter ; [ drop chloe-name? ] assoc-filter ;
: non-chloe-attrs-only ( assoc -- assoc' ) : non-chloe-attrs-only ( assoc -- assoc' )
[ drop url>> chloe-ns = not ] assoc-filter ; [ drop chloe-name? not ] assoc-filter ;
: chloe-tag? ( tag -- ? ) : chloe-tag? ( tag -- ? )
dup xml? [ body>> ] when dup xml? [ body>> ] when
{ {
{ [ dup tag? not ] [ f ] } { [ dup tag? not ] [ f ] }
{ [ dup url>> chloe-ns = not ] [ f ] } { [ dup chloe-name? not ] [ f ] }
[ t ] [ t ]
} cond nip ; } cond nip ;
@ -49,7 +49,7 @@ DEFER: compile-element
reset-buffer "@" ?head [ , [ value present ] % ] [ , ] if ; reset-buffer "@" ?head [ , [ value present ] % ] [ , ] if ;
: compile-attrs ( assoc -- ) : compile-attrs ( assoc -- )
[ attrs>> [
" " [write] " " [write]
swap name>string [write] swap name>string [write]
"=\"" [write] "=\"" [write]

14
basis/html/templates/chloe/syntax/syntax.factor
View File

@ -21,14 +21,14 @@ tags global [ H{ } clone or ] change-at
: chloe-ns "http://factorcode.org/chloe/1.0" ; inline : chloe-ns "http://factorcode.org/chloe/1.0" ; inline
: chloe-name ( string -- name ) : chloe-name? ( name -- ? )
name new url>> chloe-ns = ;
swap >>main
chloe-ns >>url ; XML-NS: chloe-name http://factorcode.org/chloe/1.0
: required-attr ( tag name -- value ) : required-attr ( tag name -- value )
dup chloe-name rot at* tuck chloe-name attr
[ nip ] [ drop " attribute is required" append throw ] if ; [ nip ] [ " attribute is required" append throw ] if* ;
: optional-attr ( tag name -- value ) : optional-attr ( tag name -- value )
chloe-name swap at ; chloe-name attr ;