XML fixes

db4
Daniel Ehrenberg 2007-12-19 12:33:34 -05:00
parent 27ed0225ab
commit 58a0dff77c
2 changed files with 7 additions and 7 deletions
extra

View File

@ -8,7 +8,7 @@ IN: faq
: find-after ( seq quot -- elem after ) : find-after ( seq quot -- elem after )
over >r find r> rot 1+ tail ; inline over >r find r> rot 1+ tail ; inline
: tag-named? ( tag name -- ? ) : tag-named*? ( tag name -- ? )
assure-name swap tag-named? ; assure-name swap tag-named? ;
! Questions ! Questions
@ -16,8 +16,8 @@ TUPLE: q/a question answer ;
C: <q/a> q/a C: <q/a> q/a
: li>q/a ( li -- q/a ) : li>q/a ( li -- q/a )
[ "br" tag-named? not ] subset [ "br" tag-named*? not ] subset
[ "strong" tag-named? ] find-after [ "strong" tag-named*? ] find-after
>r tag-children r> <q/a> ; >r tag-children r> <q/a> ;
: q/a>li ( q/a -- li ) : q/a>li ( q/a -- li )

View File

@ -120,10 +120,10 @@ M: xml xml-inject >r delegate >r xml-inject ;
dup tag? [ names-match? ] [ 2drop f ] if ; dup tag? [ names-match? ] [ 2drop f ] if ;
: tag-named* ( tag name/string -- matching-tag ) : tag-named* ( tag name/string -- matching-tag )
assure-name swap [ dupd tag-named? ] xml-find nip ; assure-name [ swap tag-named? ] curry xml-find ;
: tags-named* ( tag name/string -- tags-seq ) : tags-named* ( tag name/string -- tags-seq )
assure-name swap [ dupd tag-named? ] xml-subset nip ; assure-name [ swap tag-named? ] curry xml-subset ;
: tag-named ( tag name/string -- matching-tag ) : tag-named ( tag name/string -- matching-tag )
! like get-name-tag but only looks at direct children, ! like get-name-tag but only looks at direct children,
@ -144,7 +144,7 @@ M: xml xml-inject >r delegate >r xml-inject ;
>r 1vector r> insert-children ; >r 1vector r> insert-children ;
: tag-with-attr? ( elem attr-value attr-name -- ? ) : tag-with-attr? ( elem attr-value attr-name -- ? )
rot dup tag? [ at = ] [ drop f ] if ; rot dup tag? [ at = ] [ 3drop f ] if ;
: tag-with-attr ( tag attr-value attr-name -- matching-tag ) : tag-with-attr ( tag attr-value attr-name -- matching-tag )
assure-name [ tag-with-attr? ] 2curry find nip ; assure-name [ tag-with-attr? ] 2curry find nip ;
@ -153,7 +153,7 @@ M: xml xml-inject >r delegate >r xml-inject ;
assure-name [ tag-with-attr? ] 2curry subset ; assure-name [ tag-with-attr? ] 2curry subset ;
: tag-with-attr* ( tag attr-value attr-name -- matching-tag ) : tag-with-attr* ( tag attr-value attr-name -- matching-tag )
assure-name [ tag-with-attr? ] 2curry xml-find nip ; assure-name [ tag-with-attr? ] 2curry xml-find ;
: tags-with-attr* ( tag attr-value attr-name -- tags-seq ) : tags-with-attr* ( tag attr-value attr-name -- tags-seq )
assure-name [ tag-with-attr? ] 2curry xml-subset ; assure-name [ tag-with-attr? ] 2curry xml-subset ;