2009-01-22 20:04:48 -05:00
|
|
|
USING: kernel xml sequences assocs tools.test io arrays namespaces fry
|
2009-02-05 22:17:03 -05:00
|
|
|
accessors xml.data xml.traversal xml.writer generic sequences.deep multiline ;
|
2008-03-01 17:00:45 -05:00
|
|
|
IN: xml.tests
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-03-22 19:37:28 -04:00
|
|
|
CONSTANT: sub-tag
|
|
|
|
|
T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" }
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
SYMBOL: ref-table
|
|
|
|
|
|
|
|
|
|
GENERIC: (r-ref) ( xml -- )
|
|
|
|
|
M: tag (r-ref)
|
2009-01-29 14:33:04 -05:00
|
|
|
dup sub-tag attr [
|
2007-09-20 18:09:08 -04:00
|
|
|
ref-table get at
|
2008-08-28 18:30:58 -04:00
|
|
|
>>children drop
|
2009-01-29 14:33:04 -05:00
|
|
|
] [ drop ] 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
|
|
|
|
|
|
2009-01-22 20:04:48 -05:00
|
|
|
STRING: 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>
|
|
|
|
|
;
|
|
|
|
|
|
|
|
|
|
STRING: expected-result
|
|
|
|
|
<?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>
|
|
|
|
|
;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
: test-refs ( -- string )
|
|
|
|
|
[
|
|
|
|
|
H{
|
|
|
|
|
{ "foo" { "foo" } }
|
2009-01-22 20:04:48 -05:00
|
|
|
{ "bar" { "blah" T{ tag f T{ name f "" "a" "" } T{ attrs } f } } }
|
2007-09-20 18:09:08 -04:00
|
|
|
{ "baz" f }
|
|
|
|
|
} ref-table set
|
2009-01-22 20:04:48 -05:00
|
|
|
sample-doc string>xml dup template pprint-xml>string
|
2007-09-20 18:09:08 -04:00
|
|
|
] with-scope ;
|
|
|
|
|
|
2009-01-22 20:04:48 -05:00
|
|
|
expected-result '[ _ ] [ test-refs ] unit-test
|
