! Copyright (C) 2005, 2009 Daniel Ehrenberg
! 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 ;
+USING: accessors ascii assocs combinators
+combinators.short-circuit kernel make math namespaces sequences
+xml.char-classes xml.data xml.errors xml.state xml.tokenize ;
IN: xml.name
! XML namespace processing: ns = namespace
[
[
swap dup space>> "xmlns" =
- [ main>> set ]
+ [ main>> ,, ]
[
T{ name f "" "xmlns" f } names-match?
- [ "" set ] [ drop ] if
+ [ "" ,, ] [ drop ] if
] if
] assoc-each
- ] { } make-assoc f like ;
+ ] { } make f like ;
: add-ns ( name -- )
dup space>> dup ns-stack get assoc-stack
- [ nip ] [ nonexist-ns ] if* >>url drop ;
+ [ ] [ nonexist-ns ] ?if >>url drop ;
: push-ns ( hash -- )
ns-stack get push ;
: valid-name? ( str -- ? )
[ f ] [
- version=1.0? swap {
+ version-1.0? swap {
[ first name-start? ]
[ rest-slice [ name-char? ] with all? ]
} 2&&
] if-empty ;
+<PRIVATE
+
+: valid-name-start? ( str -- ? )
+ [ f ] [ version-1.0? swap first name-start? ] if-empty ;
+
+: maybe-name ( space main -- name/f )
+ 2dup {
+ [ drop valid-name-start? ]
+ [ nip valid-name-start? ]
+ } 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 [ ] [
- dup valid-name?
- [ <simple-name> ] [ bad-name ] if
- ] ?if ;
+ dup prefixed-name [ ] [ <simple-name> ] ?if ;
+
+PRIVATE>
: take-name ( -- string )
- version=1.0? '[ _ get-char name-char? not ] take-until ;
+ version-1.0? '[ _ swap name-char? not ] take-until ;
: parse-name ( -- name )
take-name interpret-name ;
} case ;
: take-word ( -- string )
- [ get-char blank? ] take-until ;
+ [ blank? ] take-until ;
: take-external-id ( -- external-id )
take-word (take-external-id) ;