xmode.loader: fix parsing of nodes containing cdata

diff --git a/basis/xml/traversal/traversal.factor b/basis/xml/traversal/traversal.factor
index 7cf9812cd3af79d110ea8975e39687eedded63ab..15f20bec9521c435ef22d4f3a8f0345dcd5241fe 100644 (file)
--- a/basis/xml/traversal/traversal.factor
+++ b/basis/xml/traversal/traversal.factor
@@ -4,8 +4,10 @@ USING: accessors combinators kernel make sequences
 sequences.deep strings xml.data ;
 IN: xml.traversal
 
-: children>string ( tag -- string )
-    children>> {
+<PRIVATE
+
+: (children>string) ( children -- string )
+    {
         { [ dup empty? ] [ drop "" ] }
         {
             [ dup [ string? not ] any? ]
@@ -14,6 +16,11 @@ IN: xml.traversal
         [ concat ]
     } cond ;
 
+PRIVATE>
+
+: children>string ( tag -- string )
+    children>> (children>string) ;
+
 : deep-children>string ( tag -- string )
     children>> [
         [ dup tag? [ deep-children>string ] when % ] each

diff --git a/basis/xmode/loader/syntax/syntax.factor b/basis/xmode/loader/syntax/syntax.factor
index 21cc57077db3650db635be191afe57547e2c327d..b2e91a77faefe4895a5411400112bed47de5ad0a 100644 (file)
--- a/basis/xmode/loader/syntax/syntax.factor
+++ b/basis/xmode/loader/syntax/syntax.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators kernel lexer make
 namespaces parser sequences splitting xml.data xml.syntax
-xml.syntax.private xml.traversal xmode.rules xmode.tokens
-xmode.utilities ;
+xml.syntax.private xml.traversal xml.traversal.private
+xmode.rules xmode.tokens xmode.utilities ;
 IN: xmode.loader.syntax
 
 ! Rule tag parsing utilities
@@ -28,6 +28,9 @@ SYNTAX: RULE:
 
 : string>rule-set-name ( string -- name ) "MAIN" or ;
 
+: cdata>string ( tag -- string )
+    children>> [ dup cdata? [ text>> ] when ] map (children>string) ;
+
 ! PROP, PROPS
 : parse-prop-tag ( tag -- key value )
     [ "NAME" attr ] [ "VALUE" attr ] bi ;
@@ -42,12 +45,12 @@ SYNTAX: RULE:
     [ attr string>boolean ] with map first3 ;
 
 : parse-literal-matcher ( tag -- matcher )
-    dup children>string
+    dup cdata>string
     rule-set get ignore-case?>> <string-matcher>
     swap position-attrs <matcher> ;
 
 : parse-regexp-matcher ( tag -- matcher )
-    dup children>string
+    dup cdata>string
     rule-set get ignore-case?>> <?insensitive-regexp>
     swap position-attrs <matcher> ;
 
@@ -102,4 +105,4 @@ TAG: END parse-begin/end-tag
 : init-eol-span-tag ( -- ) [ drop init-eol-span ] , ;
 
 : parse-keyword-tag ( tag keyword-map -- )
-    [ dup main>> string>token swap children>string ] dip set-at ;
+    [ dup main>> string>token swap cdata>string ] dip set-at ;