fix xml for new accessors
parent
52acaa47e7
commit
046b8b9cbe
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences sequences.private assocs arrays
|
USING: kernel sequences sequences.private assocs arrays
|
||||||
delegate.protocols delegate vectors accessors multiline
|
delegate.protocols delegate vectors accessors multiline
|
||||||
macros words quotations combinators ;
|
macros words quotations combinators slots ;
|
||||||
IN: xml.data
|
IN: xml.data
|
||||||
|
|
||||||
TUPLE: name space main url ;
|
TUPLE: name space main url ;
|
||||||
|
@ -89,7 +89,7 @@ TUPLE: tag name attrs children ;
|
||||||
tag boa ;
|
tag boa ;
|
||||||
|
|
||||||
! For convenience, tags follow the assoc protocol too (for attrs)
|
! For convenience, tags follow the assoc protocol too (for attrs)
|
||||||
CONSULT: assoc-protocol tag tag-attrs ;
|
CONSULT: assoc-protocol tag attrs>> ;
|
||||||
INSTANCE: tag assoc
|
INSTANCE: tag assoc
|
||||||
|
|
||||||
! They also follow the sequence protocol (for children)
|
! They also follow the sequence protocol (for children)
|
||||||
|
@ -100,14 +100,14 @@ CONSULT: name tag name>> ;
|
||||||
|
|
||||||
M: tag like
|
M: tag like
|
||||||
over tag? [ drop ] [
|
over tag? [ drop ] [
|
||||||
[ name>> ] keep tag-attrs
|
[ name>> ] keep attrs>>
|
||||||
rot dup [ V{ } like ] when <tag>
|
rot dup [ V{ } like ] when <tag>
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
MACRO: clone-slots ( class -- tuple )
|
MACRO: clone-slots ( class -- tuple )
|
||||||
[
|
[
|
||||||
"slots" word-prop
|
"slots" word-prop
|
||||||
[ reader>> 1quotation [ clone ] compose ] map
|
[ name>> reader-word 1quotation [ clone ] compose ] map
|
||||||
[ cleave ] curry
|
[ cleave ] curry
|
||||||
] [ [ boa ] curry ] bi compose ;
|
] [ [ boa ] curry ] bi compose ;
|
||||||
|
|
||||||
|
|
|
@ -171,7 +171,7 @@ M: bad-directive summary ( obj -- str )
|
||||||
[
|
[
|
||||||
dup call-next-method write
|
dup call-next-method write
|
||||||
"Misplaced directive:" print
|
"Misplaced directive:" print
|
||||||
bad-directive-dir write-item nl
|
dir>> write-item nl
|
||||||
] with-string-writer ;
|
] with-string-writer ;
|
||||||
|
|
||||||
UNION: xml-parse-error multitags notags extra-attrs nonexist-ns
|
UNION: xml-parse-error multitags notags extra-attrs nonexist-ns
|
||||||
|
|
Loading…
Reference in New Issue