]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/xml/syntax/syntax.factor
factor: trim using lists
[factor.git] / basis / xml / syntax / syntax.factor
index e7e8714b294a050e6f7374b21eecac95c3bd2f65..aeebe98bbe66cc65d38bf71a6d352e2dfa107ed6 100644 (file)
@@ -1,22 +1,21 @@
 ! 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 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 ;
@@ -28,16 +27,16 @@ M: no-tag summary
 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
 
@@ -72,7 +71,7 @@ SYNTAX: XML-NS:
 DEFER: interpolate-sequence
 
 : get-interpolated ( interpolated -- quot )
-    var>> '[ [ _ swap at ] keep ] ;
+    var>> '[ [ _ of ] keep ] ;
 
 : ?present ( object -- string )
     dup [ present ] when ;
@@ -82,14 +81,11 @@ DEFER: interpolate-sequence
     [ 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 )
@@ -106,6 +102,10 @@ M: xml-data push-item , ;
 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 % ;
 
@@ -145,13 +145,13 @@ MACRO: interpolate-xml ( xml -- quot )
     ] 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 ? )
     {