! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: words assocs kernel accessors parser vocabs.parser
-effects.parser sequences summary lexer splitting combinators
-locals memoize sequences.deep xml.data xml.state xml namespaces
-present arrays generalizations sequences.generalizations strings
-make math macros multiline combinators.short-circuit sorting fry
-unicode.categories effects ;
+USING: accessors arrays assocs combinators effects
+effects.parser kernel lexer make math memoize multiline
+namespaces parser present sequences sequences.deep
+sequences.generalizations strings summary unicode
+words xml xml.data xml.state ;
IN: xml.syntax
<PRIVATE
-TUPLE: no-tag name word ;
+ERROR: no-tag name word ;
+
M: no-tag summary
drop "The tag-dispatching word has no method for the given tag name" ;
: compile-tags ( word xtable -- quot )
- >alist swap '[ _ no-tag boa throw ] suffix
- '[ dup main>> _ case ] ;
+ >alist swap '[ _ no-tag ] suffix '[ dup main>> _ case ] ;
: define-tags ( word effect -- )
[ dup dup "xtable" word-prop compile-tags ] dip define-declared ;
PRIVATE>
SYNTAX: TAGS:
- CREATE-WORD complete-effect
+ scan-new-word scan-effect
[ drop H{ } clone "xtable" set-word-prop ]
[ define-tags ]
2bi ;
SYNTAX: TAG:
- scan scan-word parse-definition define-tag ;
+ scan-token scan-word parse-definition define-tag ;
SYNTAX: XML-NS:
- CREATE-WORD scan '[ f swap _ <name> ] (( string -- name )) define-memoized ;
+ scan-new-word scan-token '[ f swap _ <name> ] ( string -- name ) define-memoized ;
<PRIVATE
DEFER: interpolate-sequence
: get-interpolated ( interpolated -- quot )
- var>> '[ [ _ swap at ] keep ] ;
+ var>> '[ [ _ of ] keep ] ;
: ?present ( object -- string )
dup [ present ] when ;
[ get-interpolated '[ _ swap @ [ ?present 2array ] dip ] ]
[ 2array '[ _ swap ] ] if ;
-: filter-nulls ( assoc -- newassoc )
- [ nip ] assoc-filter ;
-
: interpolate-attrs ( attrs -- quot )
[
[ [ interpolate-attr ] { } assoc>map [ ] join ]
[ assoc-size ] bi
- '[ @ _ swap [ narray filter-nulls <attrs> ] dip ]
+ '[ @ _ swap [ narray sift-values <attrs> ] dip ]
] when-interpolated ;
: interpolate-tag ( tag -- quot )
M: object push-item present , ;
M: sequence push-item
dup xml-data? [ , ] [ [ push-item ] each ] if ;
+M: xml push-item
+ [ before>> push-item ]
+ [ body>> push-item ]
+ [ after>> push-item ] tri ;
M: number push-item present , ;
M: xml-chunk push-item % ;
] each-interpolated drop ;
: >search-hash ( seq -- hash )
- [ dup search ] H{ } map>assoc ;
+ [ dup parse-word ] H{ } map>assoc ;
: extract-variables ( xml -- seq )
[ [ var>> , ] each-interpolated ] { } make ;
: nenum ( ... n -- assoc )
- narray <enum> ; inline
+ narray <enumerated> ; inline
: collect ( accum variables -- accum ? )
{