! 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 ;
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&& ;
: <simple-name> ( string -- name )
"" swap f <name> ;
: 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 )
! 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
} 2&&
] if-empty ;
+: maybe-name ( space main -- name/f )
+ 2dup {
+ [ drop valid-name? ]
+ [ nip valid-name? ]
+ } 2&& [ f <name> ] [ 2drop f ] if ;
+
: prefixed-name ( str -- name/f )
- ":" split dup length 2 = [
- [ [ valid-name? ] all? ]
- [ first2 f <name> ] 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 [ ] [
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
: ?filter-children ( children -- no-whitespace )\r
xml-pprint? get [\r
[ dup string? [ [ blank? ] trim ] when ] map\r
- [ [ empty? ] [ string? ] bi and not ] filter\r
+ [ "" = not ] filter\r
] when ;\r
\r
PRIVATE>\r
[ 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