From 0c3e6501fe22b0838400edf82cda1fa44a9569e1 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 30 Nov 2007 23:22:08 -0500 Subject: [PATCH] New XML generation sytnax and word in sequences.lib --- extra/delegate/delegate.factor | 2 +- extra/rss/rss.factor | 31 +++++++------- extra/sequences/lib/lib.factor | 4 ++ extra/xml/generator/generator.factor | 61 +++++++++++++++++++++++++++- extra/xml/utilities/utilities.factor | 5 ++- 5 files changed, 84 insertions(+), 19 deletions(-) diff --git a/extra/delegate/delegate.factor b/extra/delegate/delegate.factor index 8dc3e3720e..2f13499867 100644 --- 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 8a9be3f9f6..d34a985518 100644 --- 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 ; @@ -74,30 +74,29 @@ C: entry : download-feed ( url -- feed ) #! Retrieve an news syndication file, return as a feed tuple. - http-get rot 200 = [ + http-get-stream rot 200 = [ nip read-feed ] [ 2drop "Error retrieving newsfeed file" throw ] if ; ! Atom generation -: simple-tag, ( content name -- ) - [ , ] tag, ; - : entry, ( entry -- ) - "entry" [ - dup entry-title "title" simple-tag, - "link" over entry-link "href" associate contained*, - dup entry-pub-date "published" simple-tag, - entry-description "content" simple-tag, - ] 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* ; + > [ + << title >> [ dup feed-title , ] + << link [ dup feed-link ] == href // >> + feed-entries [ entry, ] each + ] + XML> ; : write-feed ( feed -- xml ) feed>xml write-xml ; diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 33cfe80fcc..2f98e27467 100644 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -62,3 +62,7 @@ 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 diff --git a/extra/xml/generator/generator.factor b/extra/xml/generator/generator.factor index d5eb64388c..1d1a6c09d3 100644 --- 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 -- ) , ; @@ -21,3 +24,59 @@ IN: xml.generator (tag,) build-xml ; inline : make-xml ( name quot -- xml ) f swap make-xml* ; inline + +SYMBOL: namespace-table +: with-namespaces ( table quot -- ) + >r H{ } assoc-like namespace-table r> with-variable ; inline + +: parsed-name ( accum -- accum ) + scan ":" split1 [ f ] [ ] 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" 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 ; + +DEFER: XML> + +: [ >quotation ] parse-literal + { } parsed \ make parsed \ >xml-document parsed ; parsing diff --git a/extra/xml/utilities/utilities.factor b/extra/xml/utilities/utilities.factor index 303de4295e..1bd7b8f149 100644 --- a/extra/xml/utilities/utilities.factor +++ b/extra/xml/utilities/utilities.factor @@ -42,8 +42,11 @@ M: process-missing error. : build-tag ( item name -- tag ) >r 1array r> build-tag* ; +: standard-prolog ( -- prolog ) + T{ prolog f "1.0" "iso-8859-1" f } ; + : build-xml ( tag -- xml ) - T{ prolog f "1.0" "iso-8859-1" f } { } rot { } ; + standard-prolog { } rot { } ; : children>string ( tag -- string ) tag-children