diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index 331b565b98..4410cd7599 100644
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -7,16 +7,16 @@ html.templates html.templates.chloe.syntax continuations ;
IN: html.templates.chloe.compiler
: chloe-attrs-only ( assoc -- assoc' )
- [ drop url>> chloe-ns = ] assoc-filter ;
+ [ drop chloe-name? ] assoc-filter ;
: non-chloe-attrs-only ( assoc -- assoc' )
- [ drop url>> chloe-ns = not ] assoc-filter ;
+ [ drop chloe-name? not ] assoc-filter ;
: chloe-tag? ( tag -- ? )
dup xml? [ body>> ] when
{
{ [ dup tag? not ] [ f ] }
- { [ dup url>> chloe-ns = not ] [ f ] }
+ { [ dup chloe-name? not ] [ f ] }
[ t ]
} cond nip ;
@@ -49,7 +49,7 @@ DEFER: compile-element
reset-buffer "@" ?head [ , [ value present ] % ] [ , ] if ;
: compile-attrs ( assoc -- )
- [
+ attrs>> [
" " [write]
swap name>string [write]
"=\"" [write]
diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor
index 90c171917b..fb457ff1df 100644
--- a/basis/html/templates/chloe/syntax/syntax.factor
+++ b/basis/html/templates/chloe/syntax/syntax.factor
@@ -21,14 +21,14 @@ tags global [ H{ } clone or ] change-at
: chloe-ns "http://factorcode.org/chloe/1.0" ; inline
-: chloe-name ( string -- name )
- name new
- swap >>main
- chloe-ns >>url ;
+: chloe-name? ( name -- ? )
+ url>> chloe-ns = ;
+
+XML-NS: chloe-name http://factorcode.org/chloe/1.0
: required-attr ( tag name -- value )
- dup chloe-name rot at*
- [ nip ] [ drop " attribute is required" append throw ] if ;
+ tuck chloe-name attr
+ [ nip ] [ " attribute is required" append throw ] if* ;
: optional-attr ( tag name -- value )
- chloe-name swap at ;
+ chloe-name attr ;
diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor
index edfc6e312b..e7305ed372 100644
--- a/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@ -5,7 +5,7 @@ sequences strings splitting calendar continuations accessors vectors
math.order hashtables byte-arrays destructors
io io.sockets io.streams.string io.files io.timeouts
io.pathnames io.encodings io.encodings.string io.encodings.ascii
-io.encodings.utf8 io.encodings.8-bit io.encodings.binary
+io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.crlf
io.streams.duplex fry ascii urls urls.encoding present
http http.parsers http.client.post-data ;
IN: http.client
diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor
index c9ec2c7f3e..b4af727caa 100755
--- a/basis/http/server/server.factor
+++ b/basis/http/server/server.factor
@@ -14,6 +14,7 @@ io.encodings.binary
io.streams.limited
io.servers.connection
io.timeouts
+io.crlf
fry logging logging.insomniac calendar urls urls.encoding
mime.multipart
unicode.categories
diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor
index e6f1986874..2410cc284e 100644
--- a/basis/specialized-vectors/functor/functor.factor
+++ b/basis/specialized-vectors/functor/functor.factor
@@ -33,7 +33,7 @@ M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ;
: >V ( seq -- vector ) V new clone-like ; inline
-M: V pprint-delims drop V{ \ } ;
+M: V pprint-delims drop \ V{ \ } ;
M: V >pprint-sequence ;
diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor
index fadb4f4fb3..58b2279cb1 100644
--- a/basis/syndication/syndication.factor
+++ b/basis/syndication/syndication.factor
@@ -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 ;
diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor
index 5dc13adf16..6cd975d42d 100644
--- a/basis/xml/data/data.factor
+++ b/basis/xml/data/data.factor
@@ -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/xml name -- string )
+ swap attrs>> at ;
+
+: set-attr ( tag/xml value name -- )
+ rot attrs>> set-at ;
! They also follow the sequence protocol (for children)
CONSULT: sequence-protocol tag children>> ;
@@ -186,9 +188,6 @@ C: xml
CONSULT: sequence-protocol xml body>> ;
INSTANCE: xml sequence
-CONSULT: assoc-protocol xml body>> ;
-INSTANCE: xml assoc
-
CONSULT: tag xml body>> ;
CONSULT: name xml body>> ;
@@ -217,8 +216,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
+
+UNION: xml-data
+ tag comment string directive instruction unescaped ;
+
+TUPLE: xml-chunk seq ;
+C: xml-chunk
+
+CONSULT: sequence-protocol xml-chunk seq>> ;
+INSTANCE: xml-chunk sequence
diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor
index 57e91cc24e..116acb076b 100644
--- a/basis/xml/elements/elements.factor
+++ b/basis/xml/elements/elements.factor
@@ -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 )
diff --git a/basis/xml/interpolate/interpolate-tests.factor b/basis/xml/interpolate/interpolate-tests.factor
index 817cb453fa..35c4e793ea 100644
--- a/basis/xml/interpolate/interpolate-tests.factor
+++ b/basis/xml/interpolate/interpolate-tests.factor
@@ -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 classes ;
IN: xml.interpolate.tests
[ "a" "c" { "a" "c" f } ] [
"<-a->/><->"
string>doc
[ second var>> ]
- [ fourth "val" swap at var>> ]
+ [ fourth "val" attr var>> ]
[ extract-variables ] tri
] unit-test
@@ -54,6 +54,15 @@ IN: xml.interpolate.tests
[ "3" ] [ 3 [XML <-> XML] xml-chunk>string ] unit-test
[ "" ] [ f [XML <-> XML] xml-chunk>string ] unit-test
-\ parse-def must-infer
-[ "" interpolate-chunk ] must-infer
+\ <-> /> XML] ] must-infer
+
+[ xml-chunk ] [ [ [XML XML] ] first class ] unit-test
+[ xml ] [ [ XML> ] first class ] unit-test
+[ xml-chunk ] [ [ [XML /> XML] ] third class ] unit-test
+[ xml ] [ [ /> XML> ] third class ] unit-test
+[ 1 ] [ [ [XML XML] ] length ] unit-test
+[ 1 ] [ [ XML> ] length ] unit-test
+
+[ "" ] [ [XML XML] concat ] unit-test
diff --git a/basis/xml/interpolate/interpolate.factor b/basis/xml/interpolate/interpolate.factor
index 0b3bb15456..e28e83e47f 100644
--- a/basis/xml/interpolate/interpolate.factor
+++ b/basis/xml/interpolate/interpolate.factor
@@ -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 , ;
@@ -63,14 +64,18 @@ M: interpolated interpolate-item
: number<-> ( doc -- dup )
0 over [
- dup var>> [ over >>var [ 1+ ] dip ] unless drop
+ dup var>> [
+ over >>var [ 1+ ] dip
+ ] unless drop
] each-interpolated drop ;
-MACRO: interpolate-xml ( string -- doc )
- string>doc number<-> '[ _ interpolate-xml-doc ] ;
+GENERIC: interpolate-xml ( table xml -- xml )
-MACRO: interpolate-chunk ( string -- chunk )
- string>chunk number<-> '[ _ interpolate-sequence ] ;
+M: xml interpolate-xml
+ interpolate-xml-doc ;
+
+M: xml-chunk interpolate-xml
+ interpolate-sequence ;
: >search-hash ( seq -- hash )
[ dup search ] H{ } map>assoc ;
@@ -81,26 +86,24 @@ MACRO: interpolate-chunk ( string -- chunk )
: nenum ( ... n -- assoc )
narray ; inline
-: collect ( accum seq -- accum )
+: collect ( accum variables -- accum ? )
{
- { [ dup [ ] all? ] [ >search-hash parsed ] } ! locals
- { [ dup [ not ] all? ] [ ! fry
- length parsed \ nenum parsed
- ] }
+ { [ dup empty? ] [ drop f ] } ! Just a literal
+ { [ dup [ ] all? ] [ >search-hash parsed t ] } ! locals
+ { [ dup [ not ] all? ] [ length parsed \ nenum parsed t ] } ! fry
[ drop "XML interpolation contains both fry and locals" throw ] ! mixed
} cond ;
-: parse-def ( accum delimiter word -- accum )
- [
- parse-multiline-string but-last
- [ string>chunk extract-variables collect ] keep
- parsed
- ] dip parsed ;
+: parse-def ( accum delimiter quot -- accum )
+ [ parse-multiline-string 1 short head* ] dip call
+ [ extract-variables collect ] keep swap
+ [ number<-> parsed ] dip
+ [ \ interpolate-xml parsed ] when ; inline
PRIVATE>
: " \ interpolate-xml parse-def ; parsing
+ "XML>" [ string>doc ] parse-def ; parsing
: [XML
- "XML]" \ interpolate-chunk parse-def ; parsing
+ "XML]" [ string>chunk ] parse-def ; parsing
diff --git a/basis/xml/tests/test.factor b/basis/xml/tests/test.factor
index e3a7fdbc7a..97793f2ab2 100644
--- a/basis/xml/tests/test.factor
+++ b/basis/xml/tests/test.factor
@@ -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
[ "" 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" ] [
"abcd" string>xml
[ [ dup string? [ % ] [ drop ] if ] deep-each ] "" make
@@ -43,9 +43,11 @@ SYMBOL: xml-file
"foo" string>xml
"c" get-id children>string
] unit-test
-[ "foo" ] [ "" string>xml "y" over
- at swap "z" [ tuck ] dip swap set-at
- T{ name f "blah" "z" f } swap at ] unit-test
+[ "foo" ] [
+ "" string>xml
+ dup dup "y" attr "z" set-attr
+ T{ name { space "blah" } { main "z" } } attr
+] unit-test
[ "foo" ] [ "" string>xml children>string ] unit-test
[ "" string>xml ] must-fail
[ ] [ "" string>xml drop ] unit-test
@@ -58,5 +60,6 @@ SYMBOL: xml-file
[ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "" string>xml-chunk first ] unit-test
[ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "" string>xml-chunk first ] unit-test
[ 958 ] [ [ "ξ" string>xml-chunk ] with-html-entities first first ] unit-test
-[ "x" "<" ] [ "" string>xml [ name>> main>> ] [ "value" swap at ] bi ] unit-test
+[ "x" "<" ] [ "" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test
[ "foo" ] [ "]>&bar;" string>xml children>string ] unit-test
+[ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test
diff --git a/basis/xml/tests/xmltest.factor b/basis/xml/tests/xmltest.factor
index 8caa5e8a75..a6a28e15a3 100644
--- a/basis/xml/tests/xmltest.factor
+++ b/basis/xml/tests/xmltest.factor
@@ -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
diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor
index e9959c1ef4..dcf7f1023d 100644
--- a/basis/xml/writer/writer-tests.factor
+++ b/basis/xml/writer/writer-tests.factor
@@ -52,7 +52,6 @@ IN: xml.writer.tests
&foo;"} pprint-reprints-as
[ t ] [ "" dup string>xml-chunk xml-chunk>string = ] unit-test
-[ V{ "hello" } ] [ "hello" string>xml-chunk ] unit-test
[ "" ]
[ "" string>xml xml>string ] unit-test
[ "bar baz" ]
diff --git a/basis/xml/xml.factor b/basis/xml/xml.factor
index b043d5771e..5369b04d9c 100644
--- a/basis/xml/xml.factor
+++ b/basis/xml/xml.factor
@@ -162,7 +162,8 @@ PRIVATE>
: read-xml-chunk ( stream -- seq )
1 depth
- [ (read-xml-chunk) nip ] with-variable ;
+ [ (read-xml-chunk) nip ] with-variable
+ ;
: string>xml ( string -- xml )
t string-input?
diff --git a/basis/xmode/catalog/catalog.factor b/basis/xmode/catalog/catalog.factor
index f8f1788bcf..8a8e5fad4a 100644
--- a/basis/xmode/catalog/catalog.factor
+++ b/basis/xmode/catalog/catalog.factor
@@ -1,6 +1,6 @@
USING: xmode.loader xmode.utilities xmode.rules namespaces
strings splitting assocs sequences kernel io.files xml memoize
-words globs combinators io.encodings.utf8 sorting accessors ;
+words globs combinators io.encodings.utf8 sorting accessors xml.data ;
IN: xmode.catalog
TUPLE: mode file file-name-glob first-line-glob ;
@@ -8,7 +8,7 @@ TUPLE: mode file file-name-glob first-line-glob ;
>file) }
{ "FILE_NAME_GLOB" f (>>file-name-glob) }
diff --git a/basis/xmode/loader/loader.factor b/basis/xmode/loader/loader.factor
index 8639c93e71..64c4234bd3 100644
--- a/basis/xmode/loader/loader.factor
+++ b/basis/xmode/loader/loader.factor
@@ -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 ;
diff --git a/basis/xmode/utilities/utilities.factor b/basis/xmode/utilities/utilities.factor
index 871767ccf5..d6407d8180 100644
--- a/basis/xmode/utilities/utilities.factor
+++ b/basis/xmode/utilities/utilities.factor
@@ -22,7 +22,7 @@ IN: xmode.utilities
] }
{ [ dup length 3 = ] [
first3 '[
- _ tag get at
+ tag get _ attr
_ [ execute ] when* object get _ execute
]
] }