diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor index a76c46dd0a..9752d19bf2 100644 --- a/basis/xml/data/data.factor +++ b/basis/xml/data/data.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private assocs arrays delegate.protocols delegate vectors accessors multiline -macros words quotations combinators slots fry strings ; +macros words quotations combinators slots fry strings +combinators.short-circuit ; IN: xml.data TUPLE: interpolated var ; @@ -18,9 +19,11 @@ C: name 2dup and [ = ] [ 2drop t ] if ; : names-match? ( name1 name2 -- ? ) - [ [ space>> ] bi@ ?= ] - [ [ url>> ] bi@ ?= ] - [ [ main>> ] bi@ ?= ] 2tri and and ; + { + [ [ space>> ] bi@ ?= ] + [ [ url>> ] bi@ ?= ] + [ [ main>> ] bi@ ?= ] + } 2&& ; : ( string -- name ) "" swap f ; diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor index 3ef1e669f1..4de4fc3679 100644 --- a/basis/xml/elements/elements.factor +++ b/basis/xml/elements/elements.factor @@ -18,29 +18,26 @@ IN: xml.elements : interpolate-quote ( -- interpolated ) [ quoteless-attr ] take-interpolated ; -: parse-attr ( -- ) - parse-name pass-blank "=" expect pass-blank - get-char CHAR: < eq? - [ "<-" expect interpolate-quote ] - [ t parse-quote* ] if 2array , ; - : start-tag ( -- name ? ) #! Outputs the name and whether this is a closing tag get-char CHAR: / eq? dup [ next ] when parse-name swap ; -: (middle-tag) ( -- ) - pass-blank version-1.0? get-char name-start? - [ parse-attr (middle-tag) ] when ; - : assure-no-duplicates ( attrs-alist -- attrs-alist ) H{ } clone 2dup '[ swap _ push-at ] assoc-each [ nip length 2 >= ] { } assoc-filter-as [ first first2 duplicate-attr ] unless-empty ; +: parse-attr ( -- array ) + parse-name pass-blank "=" expect pass-blank + get-char CHAR: < eq? + [ "<-" expect interpolate-quote ] + [ t parse-quote* ] if 2array ; + : middle-tag ( -- attrs-alist ) - ! f make will make a vector if it has any elements - [ (middle-tag) ] f make pass-blank + ! f produce-as will make a vector if it has any elements + [ pass-blank version-1.0? get-char name-start? ] + [ parse-attr ] f produce-as pass-blank dup length 1 > [ assure-no-duplicates ] when ; : end-tag ( name attrs-alist -- tag ) diff --git a/basis/xml/name/name.factor b/basis/xml/name/name.factor index 7f79622392..95557cb2c4 100644 --- a/basis/xml/name/name.factor +++ b/basis/xml/name/name.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces accessors xml.tokenize xml.data assocs xml.errors xml.char-classes combinators.short-circuit splitting -fry xml.state sequences combinators ascii ; +fry xml.state sequences combinators ascii math ; IN: xml.name ! XML namespace processing: ns = namespace @@ -53,11 +53,19 @@ SYMBOL: ns-stack } 2&& ] if-empty ; +: maybe-name ( space main -- name/f ) + 2dup { + [ drop valid-name? ] + [ nip valid-name? ] + } 2&& [ f ] [ 2drop f ] if ; + : prefixed-name ( str -- name/f ) - ":" split dup length 2 = [ - [ [ valid-name? ] all? ] - [ first2 f ] bi and - ] [ drop f ] if ; + CHAR: : over index [ + CHAR: : 2over 1 + swap index-from + [ 2drop f ] + [ [ head ] [ 1 + tail ] 2bi maybe-name ] + if + ] [ drop f ] if* ; : interpret-name ( str -- name ) dup prefixed-name [ ] [ diff --git a/basis/xml/tokenize/tokenize.factor b/basis/xml/tokenize/tokenize.factor index ee7ffdf639..ebabd2c893 100644 --- a/basis/xml/tokenize/tokenize.factor +++ b/basis/xml/tokenize/tokenize.factor @@ -3,16 +3,17 @@ USING: namespaces xml.state kernel sequences accessors xml.char-classes xml.errors math io sbufs fry strings ascii xml.entities assocs splitting math.parser -locals combinators arrays hints ; +locals combinators combinators.short-circuit arrays hints ; IN: xml.tokenize ! * Basic utility words : assure-good-char ( spot ch -- ) [ - over - [ version-1.0?>> over text? not ] - [ check>> ] bi and + over { + [ version-1.0?>> over text? not ] + [ check>> ] + } 1&& [ [ [ 1 + ] change-column drop ] dip disallowed-char diff --git a/basis/xml/writer/writer.factor b/basis/xml/writer/writer.factor index 3a23108dd5..6296e4cfbf 100644 --- a/basis/xml/writer/writer.factor +++ b/basis/xml/writer/writer.factor @@ -34,7 +34,7 @@ SYMBOL: indentation : ?filter-children ( children -- no-whitespace ) xml-pprint? get [ [ dup string? [ [ blank? ] trim ] when ] map - [ [ empty? ] [ string? ] bi and not ] filter + [ "" = not ] filter ] when ; PRIVATE> diff --git a/basis/xml/xml.factor b/basis/xml/xml.factor index 66780e9d67..22e1a850b7 100644 --- a/basis/xml/xml.factor +++ b/basis/xml/xml.factor @@ -89,7 +89,7 @@ M: closer process [ drop default-prolog ] unless ; : cut-prolog ( seq -- newseq ) - [ [ prolog? not ] [ "" = not ] bi and ] filter ; + [ { [ prolog? not ] [ "" = not ] } 1&& ] filter ; : make-xml-doc ( seq -- xml-doc ) [ get-prolog ] keep