Merge branch 'master' into xml

Conflicts:

	extra/rss/rss.factor
	extra/sequences/lib/lib.factor
	extra/xml/data/data.factor

diff --git a/extra/delegate/delegate.factor b/extra/delegate/delegate.factor
index 5614296305d40e0c8d823cc0eb9fa6c1eea2211d..962746ec1a33d859e5addd84893e6b6be841bfa7 100644 (file)
--- a/extra/delegate/delegate.factor
+++ b/extra/delegate/delegate.factor
@@ -42,7 +42,7 @@ M: tuple-class group-words
 
 PROTOCOL: sequence-protocol
     clone clone-like like new new-resizable nth nth-unsafe
-    set-nth set-nth-unsafe length immutable set-length lengthen ;
+    set-nth set-nth-unsafe length set-length lengthen ;
 
 PROTOCOL: assoc-protocol
     at* assoc-size >alist assoc-find set-at

diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor
index cfb1c903e852179eb198ccd072199d6db37abd3f..233dfcb221a05fd09df89c4a21c648e336ac7e87 100644 (file)
--- a/extra/rss/rss.factor
+++ b/extra/rss/rss.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: rss
-USING: xml.utilities kernel assocs
+USING: xml.utilities kernel assocs xml.generator
     strings sequences xml.data xml.writer
     io.streams.string combinators xml xml.entities io.files io
     http.client namespaces xml.generator hashtables ;
@@ -85,26 +85,22 @@ C: <entry> entry
     ] if ;
 
 ! Atom generation
-: simple-tag, ( content name -- )
-    [ , ] tag, ;
-
-: simple-tag*, ( content name attrs -- )
-    [ , ] tag*, ;
-
 : entry, ( entry -- )
-    "entry" [
-        dup entry-title "title" { { "type" "html" } } simple-tag*,
-        "link" over entry-link "href" associate contained*,
-        dup entry-pub-date "published" simple-tag,
-        entry-description [ "content" { { "type" "html" } } simple-tag*, ] when*
-    ] tag, ;
+    << entry >> [
+        << title >> [ dup entry-title , ]
+        << link [ dup entry-link ] == href // >>
+        << published >> [ dup entry-pub-date , ]
+        << content >> [ entry-description , ]
+    ] ;
 
 : feed>xml ( feed -- xml )
-    "feed" { { "xmlns" "http://www.w3.org/2005/Atom" } } [
-        dup feed-title "title" simple-tag,
-        "link" over feed-link "href" associate contained*,
-        feed-entries [ entry, ] each
-    ] make-xml* ;
+    <XML
+        << feed [ "http://www.w3.org/2005/Atom" ] == xmlns >> [
+            << title >> [ dup feed-title , ]
+            << link [ dup feed-link ] == href // >>
+            feed-entries [ entry, ] each
+        ]
+    XML> ;
 
 : write-feed ( feed -- )
     feed>xml write-xml ;

diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index ba2fb055e258e014f7c9a32b0faedd974b4411fb..ea6fdd141b24136ff6483d90d6061d13edf2954a 100644 (file)
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -64,6 +64,10 @@ IN: sequences.lib
 : delete-random ( seq -- value )
     [ length random ] keep [ nth ] 2keep delete-nth ;
 
+: split-around ( seq quot -- before elem after )
+    dupd find over [ "Element not found" throw ] unless
+    >r cut-slice 1 tail r> swap ; inline
+
 : (map-until) ( quot pred -- quot )
     [ dup ] swap 3compose
     [ [ drop t ] [ , f ] if ] compose [ find 2drop ] curry ;

diff --git a/extra/xml/data/data.factor b/extra/xml/data/data.factor
index 725d6da3cc7c819bb0d8beaf7945f5b78d19a72e..77f7c4d92943c9e93b8792cfc26186b6983978bd 100644 (file)
--- a/extra/xml/data/data.factor
+++ b/extra/xml/data/data.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2006 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences sequences.private assocs arrays vectors ;
+USING: kernel sequences sequences.private assocs arrays delegate vectors ;
 IN: xml.data
 
 TUPLE: name space tag url ;
@@ -90,24 +90,11 @@ TUPLE: tag attrs children ;
     tag construct ;
 
 ! For convenience, tags follow the assoc protocol too (for attrs)
-M: tag at* tag-attrs at* ;
-M: tag set-at tag-attrs set-at ;
-M: tag new-assoc tag-attrs new-assoc ;
-M: tag >alist tag-attrs >alist ;
-M: tag delete-at tag-attrs delete-at ;
-M: tag clear-assoc tag-attrs clear-assoc ;
-M: tag assoc-size tag-attrs assoc-size ;
-M: tag assoc-like tag-attrs assoc-like ;
-
+CONSULT: assoc-protocol tag tag-attrs ;
 INSTANCE: tag assoc
 
 ! They also follow the sequence protocol (for children)
-M: tag nth tag-children nth ;
-M: tag nth-unsafe tag-children nth-unsafe ;
-M: tag set-nth tag-children set-nth ;
-M: tag set-nth-unsafe tag-children set-nth-unsafe ;
-M: tag length tag-children length ;
-
+CONSULT: sequence-protocol tag tag-children ;
 INSTANCE: tag sequence
 
 ! tag with children=f is contained

diff --git a/extra/xml/generator/generator.factor b/extra/xml/generator/generator.factor
index d5eb64388cb1dbfef20bb0999738c840caecfdab..84edc4e55181e1a602f50bf2704c52620576133b 100644 (file)
--- a/extra/xml/generator/generator.factor
+++ b/extra/xml/generator/generator.factor
@@ -1,4 +1,7 @@
-USING: namespaces kernel xml.data xml.utilities ;
+! Copyright (C) 2006, 2007 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces kernel xml.data xml.utilities assocs splitting
+sequences parser quotations sequences.lib ;
 IN: xml.generator
 
 : comment, ( string -- ) <comment> , ;
@@ -21,3 +24,56 @@ IN: xml.generator
     (tag,) build-xml ; inline
 : make-xml ( name quot -- xml )
     f swap make-xml* ; inline
+
+! Word-based XML literal syntax
+: parsed-name ( accum -- accum )
+    scan ":" split1 [ f <name> ] [ <name-tag> ] if* parsed ;
+
+: run-combinator ( accum quot1 quot2 -- accum )
+    >r [ ] like parsed r> [ parsed ] each ;
+
+: parse-tag-contents ( accum contained? -- accum )
+    [ \ contained*, parsed ] [
+        scan-word \ [ =
+        [ POSTPONE: [ \ tag*, parsed ]
+        [ "Expected [ missing" <parse-error> throw ] if
+    ] if ;
+
+DEFER: >>
+
+: attributes-parsed ( accum quot -- accum )
+    dup empty? [ drop f parsed ] [
+        >r \ >r parsed r> parsed
+        [ H{ } make-assoc r> swap ] [ parsed ] each
+    ] if ;
+
+: <<
+    parsed-name [
+        \ >> parse-until >quotation
+        attributes-parsed \ contained? get
+    ] with-scope parse-tag-contents ; parsing
+
+: ==
+    \ call parsed parsed-name \ set parsed ; parsing
+
+: //
+    \ contained? on ; parsing
+
+: parse-special ( accum end-token word -- accum )
+    >r parse-tokens " " join parsed r> parsed ;
+
+: <!-- "-->" \ comment, parse-special ; parsing
+
+: <!  ">" \ directive, parse-special ; parsing
+
+: <? "?>" \ instruction, parse-special ; parsing
+
+: >xml-document ( seq -- xml )
+    dup first prolog? [ unclip-slice ] [ standard-prolog ] if swap
+    [ tag? ] split-around <xml> ;
+
+DEFER: XML>
+
+: <XML
+    \ XML> [ >quotation ] parse-literal
+    { } parsed \ make parsed \ >xml-document parsed ; parsing