]> gitweb.factorcode.org Git - factor.git/commitdiff
XML chunks are a separate datatype; XML tags are no longer assocs
authorDaniel Ehrenberg <littledan@Macintosh-103.local>
Wed, 28 Jan 2009 20:33:33 +0000 (14:33 -0600)
committerDaniel Ehrenberg <littledan@Macintosh-103.local>
Wed, 28 Jan 2009 20:33:33 +0000 (14:33 -0600)
basis/syndication/syndication.factor
basis/xml/data/data.factor
basis/xml/elements/elements.factor
basis/xml/interpolate/interpolate-tests.factor
basis/xml/interpolate/interpolate.factor
basis/xml/tests/test.factor
basis/xml/tests/xmltest.factor
basis/xml/writer/writer-tests.factor
basis/xml/xml.factor
basis/xmode/loader/loader.factor
basis/xmode/marker/marker.factor

index fadb4f4fb385fb57e8e4ffd9e3108ecac073ae29..58b2279cb19229d2f4773518fa95f1b7ee20aca5 100644 (file)
@@ -70,8 +70,8 @@ TUPLE: entry title url description date ;
     tri ;
 
 : atom-entry-link ( tag -- url/f )
-    "link" tags-named [ "rel" swap at "alternate" = ] find nip
-    dup [ "href" swap at >url ] when ;
+    "link" tags-named [ "rel" attr "alternate" = ] find nip
+    dup [ "href" attr >url ] when ;
 
 : atom1.0-entry ( tag -- entry )
     entry new
@@ -95,7 +95,7 @@ TUPLE: entry title url description date ;
     feed new
     swap
     [ "title" tag-named children>string >>title ]
-    [ "link" tag-named "href" swap at >url >>url ]
+    [ "link" tag-named "href" attr >url >>url ]
     [ "entry" tags-named [ atom1.0-entry ] map set-entries ]
     tri ;
 
index 5dc13adf16a6bcf1a8a6d3ce52c3b36e564cfdac..74ad348babbb709e765ce16a19ce48994ac87820 100644 (file)
@@ -150,9 +150,11 @@ TUPLE: tag
     [ assure-name ] [ T{ attrs } assoc-like ] [ ] tri*
     tag boa ;
 
-! For convenience, tags follow the assoc protocol too (for attrs)
-CONSULT: assoc-protocol tag attrs>> ;
-INSTANCE: tag assoc
+: attr ( tag name -- string )
+    swap attrs>> at ;
+
+: set-attr ( tag value name -- )
+    rot attrs>> set-at ;
 
 ! They also follow the sequence protocol (for children)
 CONSULT: sequence-protocol tag children>> ;
@@ -217,8 +219,14 @@ M: xml like
 PREDICATE: contained-tag < tag children>> not ;
 PREDICATE: open-tag < tag children>> ;
 
-UNION: xml-data
-    tag comment string directive instruction ;
-
 TUPLE: unescaped string ;
 C: <unescaped> unescaped
+
+UNION: xml-data
+    tag comment string directive instruction unescaped ;
+
+TUPLE: xml-chunk seq ;
+C: <xml-chunk> xml-chunk
+
+CONSULT: sequence-protocol xml-chunk seq>> ;
+INSTANCE: xml-chunk sequence
index 57e91cc24e125f3e306a60c6a4696965691e5d37..116acb076ba0ed0d66db00077c18dc82de8e934b 100644 (file)
@@ -65,11 +65,12 @@ IN: xml.elements
     dup { "1.0" "1.1" } member? [ bad-version ] unless ;
 
 : prolog-version ( alist -- version )
-    T{ name f "" "version" f } swap at
+    T{ name { space "" } { main "version" } } swap at
     [ good-version ] [ versionless-prolog ] if* ;
 
 : prolog-encoding ( alist -- encoding )
-    T{ name f "" "encoding" f } swap at "UTF-8" or ;
+    T{ name { space "" } { main "encoding" } } swap at
+    "UTF-8" or ;
 
 : yes/no>bool ( string -- t/f )
     {
@@ -79,7 +80,7 @@ IN: xml.elements
     } case ;
 
 : prolog-standalone ( alist -- version )
-    T{ name f "" "standalone" f } swap at
+    T{ name { space "" } { main "standalone" } } swap at
     [ yes/no>bool ] [ f ] if* ;
 
 : prolog-attrs ( alist -- prolog )
index 817cb453fa23e5aa15d64ef171a55bcef78967c8..4a7c64dd1659603ebbf8a3f641fc5bb6620633c3 100644 (file)
@@ -2,14 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test xml.interpolate multiline kernel assocs
 sequences accessors xml.writer xml.interpolate.private
-locals splitting urls ;
+locals splitting urls xml.data ;
 IN: xml.interpolate.tests
 
 [ "a" "c" { "a" "c" f } ] [
     "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
     string>doc
     [ second var>> ]
-    [ fourth "val" swap at var>> ]
+    [ fourth "val" attr var>> ]
     [ extract-variables ] tri
 ] unit-test
 
index 0b3bb1545641e43d79fb151a22b249aba85299c7..b9535fba3917c358a95a323f79a82cec8c325204 100644 (file)
@@ -33,8 +33,9 @@ M: string push-item , ;
 M: xml-data push-item , ;
 M: object push-item present , ;
 M: sequence push-item
-    [ dup array? [ % ] [ , ] if ] each ;
+    dup xml-data? [ , ] [ [ push-item ] each ] if ;
 M: number push-item present , ;
+M: xml-chunk push-item % ;
 
 GENERIC: interpolate-item ( table item -- )
 M: object interpolate-item nip , ;
index e3a7fdbc7aae4c2ffe9f15ded61e849d7954c185..97793f2ab258a31c01ade49b4a8cd97257f5c4ac 100644 (file)
@@ -19,7 +19,7 @@ SYMBOL: xml-file
 [ "a" ] [ xml-file get space>> ] unit-test
 [ "http://www.hello.com" ] [ xml-file get url>> ] unit-test
 [ "that" ] [
-    xml-file get T{ name f "" "this" "http://d.de" } swap at
+    xml-file get T{ name f "" "this" "http://d.de" } attr
 ] unit-test
 [ t ] [ xml-file get children>> second contained-tag? ] unit-test
 [ "<a></b>" string>xml ] [ xml-error? ] must-fail-with
@@ -30,7 +30,7 @@ SYMBOL: xml-file
     xml-file get after>> [ instruction? ] find nip text>>
 ] unit-test
 [ V{ "fa&g" } ] [ xml-file get "x" get-id children>> ] unit-test
-[ "that" ] [ xml-file get "this" swap at ] unit-test
+[ "that" ] [ xml-file get "this" attr ] unit-test
 [ "abcd" ] [
     "<main>a<sub>bc</sub>d<nothing/></main>" string>xml
     [ [ dup string? [ % ] [ drop ] if ] deep-each ] "" make
@@ -43,9 +43,11 @@ SYMBOL: xml-file
     "<a><b id='c'>foo</b><d id='e'/></a>" string>xml
     "c" get-id children>string
 ] unit-test
-[ "foo" ] [ "<x y='foo'/>" string>xml "y" over
-    at swap "z" [ tuck ] dip swap set-at
-    T{ name f "blah" "z" f } swap at ] unit-test
+[ "foo" ] [
+    "<x y='foo'/>" string>xml
+    dup dup "y" attr "z" set-attr
+    T{ name { space "blah" } { main "z" } } attr
+] unit-test
 [ "foo" ] [ "<boo><![CDATA[foo]]></boo>" string>xml children>string ] unit-test
 [ "<!-- B+, B, or B--->" string>xml ] must-fail
 [ ] [ "<?xml version='1.0'?><!-- declarations for <head> & <body> --><foo/>" string>xml drop ] unit-test
@@ -58,5 +60,6 @@ SYMBOL: xml-file
 [ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "<!DOCTYPE foo SYSTEM 'blah.dtd'>" string>xml-chunk first ] unit-test
 [ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "<!DOCTYPE foo   SYSTEM \"blah.dtd\"   >" string>xml-chunk first ] unit-test
 [ 958 ] [ [ "&xi;" string>xml-chunk ] with-html-entities first first ] unit-test
-[ "x" "<" ] [ "<x value='&lt;'/>" string>xml [ name>> main>> ] [ "value" swap at ] bi ] unit-test
+[ "x" "<" ] [ "<x value='&lt;'/>" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test
 [ "foo" ] [ "<!DOCTYPE foo [<!ENTITY bar 'foo'>]><x>&bar;</x>" string>xml children>string ] unit-test
+[ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test
index 8caa5e8a75a2026b22d6775ca26a4b54eb85f25b..a6a28e15a3c3af520b35da3a821bfb61fda853d1 100644 (file)
@@ -1,16 +1,16 @@
 USING: accessors assocs combinators continuations fry generalizations
 io.pathnames kernel macros sequences stack-checker tools.test xml
-xml.utilities xml.writer arrays ;
+xml.utilities xml.writer arrays xml.data ; 
 IN: xml.tests.suite
 
 TUPLE: xml-test id uri sections description type ;
 
 : >xml-test ( tag -- test )
     xml-test new swap {
-        [ "TYPE" swap at >>type ]
-        [ "ID" swap at >>id ]
-        [ "URI" swap at >>uri ]
-        [ "SECTIONS" swap at >>sections ]
+        [ "TYPE" attr >>type ]
+        [ "ID" attr >>id ]
+        [ "URI" attr >>uri ]
+        [ "SECTIONS" attr >>sections ]
         [ children>> xml-chunk>string >>description ]
     } cleave ;
 
@@ -51,3 +51,5 @@ MACRO: drop-input ( quot -- newquot )
 
 : failing-valids ( -- tests )
     partition-xml-tests nip [ second first ] map [ type>> "valid" = ] filter ;
+
+[ ] [ partition-xml-tests 2drop ] unit-test
index e9959c1ef49012a17f2c1515b09f687de8a98a50..dcf7f1023d1fe2e283c4482638b3416f69267d5b 100644 (file)
@@ -52,7 +52,6 @@ IN: xml.writer.tests
 <x>&foo;</x>"} pprint-reprints-as
 
 [ t ] [ "<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.1//EN' 'http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd' >" dup string>xml-chunk xml-chunk>string = ] unit-test
-[ V{ "hello" } ] [ "hello" string>xml-chunk ] unit-test
 [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a b=\"c\"/>" ]
     [ "<a b='c'/>" string>xml xml>string ] unit-test
 [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>bar baz</foo>" ]
index b043d5771ea175f16b5c761150dbb71510767df6..5369b04d9c1f3852f5386326964a49d04f1bade0 100644 (file)
@@ -162,7 +162,8 @@ PRIVATE>
 
 : read-xml-chunk ( stream -- seq )
     1 depth
-    [ (read-xml-chunk) nip ] with-variable ;
+    [ (read-xml-chunk) nip ] with-variable
+    <xml-chunk> ;
 
 : string>xml ( string -- xml )
     t string-input?
index 8639c93e71651ebc9b2ffc2e071a5ee9b1583362..64c4234bd3f39ed5999e557142c4c9d5fd27abf1 100644 (file)
@@ -13,10 +13,10 @@ TAG: PROPS
     parse-props-tag >>props drop ;
 
 TAG: IMPORT
-    "DELEGATE" swap at swap import-rule-set ;
+    "DELEGATE" attr swap import-rule-set ;
 
 TAG: TERMINATE
-    "AT_CHAR" swap at string>number >>terminate-char drop ;
+    "AT_CHAR" attr string>number >>terminate-char drop ;
 
 RULE: SEQ seq-rule
     shared-tag-attrs delegate-attr literal-start ;
index 798807f19807f7f1841c07ce67a14b370ff4983f..5d10d2ed02ad60cd63c684c2ea6f361e3cd18409 100644 (file)
@@ -297,7 +297,7 @@ M: mark-previous-rule handle-rule-start
 
 : tokenize-line ( line-context line rules -- line-context' seq )
     [
-        "MAIN" swap at -rot
+        "MAIN" attr -rot
         init-token-marker
         mark-token-loop
         mark-remaining