2007-09-20 18:09:08 -04:00
|
|
|
USING: kernel xml sequences assocs tools.test io arrays namespaces
|
2008-08-28 18:30:58 -04:00
|
|
|
accessors xml.data xml.utilities xml.writer generic sequences.deep ;
|
2008-03-01 17:00:45 -05:00
|
|
|
IN: xml.tests
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
: sub-tag
|
|
|
|
|
T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" } ;
|
|
|
|
|
|
|
|
|
|
SYMBOL: ref-table
|
|
|
|
|
|
|
|
|
|
GENERIC: (r-ref) ( xml -- )
|
|
|
|
|
M: tag (r-ref)
|
2008-01-31 01:47:11 -05:00
|
|
|
sub-tag over at* [
|
2007-09-20 18:09:08 -04:00
|
|
|
ref-table get at
|
2008-08-28 18:30:58 -04:00
|
|
|
>>children drop
|
2008-01-31 01:47:11 -05:00
|
|
|
] [ 2drop ] if ;
|
2007-09-20 18:09:08 -04:00
|
|
|
M: object (r-ref) drop ;
|
|
|
|
|
|
|
|
|
|
: template ( xml -- )
|
2007-12-23 14:57:39 -05:00
|
|
|
[ (r-ref) ] deep-each ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
! Example
|
|
|
|
|
|
|
|
|
|
: sample-doc
|
|
|
|
|
{
|
|
|
|
|
"<html xmlns:f='http://littledan.onigirihouse.com/namespaces/replace'>"
|
|
|
|
|
"<body>"
|
|
|
|
|
"<span f:sub='foo'/>"
|
|
|
|
|
"<div f:sub='bar'/>"
|
|
|
|
|
"<p f:sub='baz'>paragraph</p>"
|
|
|
|
|
"</body></html>"
|
|
|
|
|
} concat ;
|
|
|
|
|
|
|
|
|
|
: test-refs ( -- string )
|
|
|
|
|
[
|
|
|
|
|
H{
|
|
|
|
|
{ "foo" { "foo" } }
|
2008-08-28 18:30:58 -04:00
|
|
|
{ "bar" { "blah" T{ tag f T{ name f "" "a" "" } f f } } }
|
2007-09-20 18:09:08 -04:00
|
|
|
{ "baz" f }
|
|
|
|
|
} ref-table set
|
|
|
|
|
sample-doc string>xml dup template xml>string
|
|
|
|
|
] with-scope ;
|
|
|
|
|
|
2008-03-25 22:45:26 -04:00
|
|
|
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><html xmlns:f=\"http://littledan.onigirihouse.com/namespaces/replace\"><body><span f:sub=\"foo\">foo</span><div f:sub=\"bar\">blah<a/></div><p f:sub=\"baz\"/></body></html>" ] [ test-refs ] unit-test
|
