1 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel namespaces accessors xml.tokenize xml.data assocs
4 xml.errors xml.char-classes combinators.short-circuit splitting
5 fry xml.state sequences combinators ascii math ;
8 ! XML namespace processing: ns = namespace
10 ! A stack of hashtables
13 : attrs>ns ( attrs-alist -- hash )
14 ! this should check to make sure URIs are valid
17 swap dup space>> "xmlns" =
20 T{ name f "" "xmlns" f } names-match?
21 [ "" set ] [ drop ] if
24 ] { } make-assoc f like ;
27 dup space>> dup ns-stack get assoc-stack
28 [ nip ] [ nonexist-ns ] if* >>url drop ;
36 : init-ns-stack ( -- )
38 { "xml" "http://www.w3.org/XML/1998/namespace" }
39 { "xmlns" "http://www.w3.org/2000/xmlns" }
44 : tag-ns ( name attrs-alist -- name attrs )
46 [ dup add-ns ] dip dup [ drop add-ns ] assoc-each <attrs> ;
48 : valid-name? ( str -- ? )
52 [ rest-slice [ name-char? ] with all? ]
56 : maybe-name ( space main -- name/f )
60 } 2&& [ f <name> ] [ 2drop f ] if ;
62 : prefixed-name ( str -- name/f )
64 CHAR: : 2over 1 + swap index-from
66 [ [ head ] [ 1 + tail ] 2bi maybe-name ]
70 : interpret-name ( str -- name )
71 dup prefixed-name [ ] [
73 [ <simple-name> ] [ bad-name ] if
76 : take-name ( -- string )
77 version-1.0? '[ _ swap name-char? not ] take-until ;
79 : parse-name ( -- name )
80 take-name interpret-name ;
82 : parse-name-starting ( string -- name )
83 take-name append interpret-name ;
85 : take-system-id ( -- system-id )
86 parse-quote <system-id> ;
88 : take-public-id ( -- public-id )
89 parse-quote parse-quote <public-id> ;
91 : (take-external-id) ( token -- external-id )
93 { "SYSTEM" [ take-system-id ] }
94 { "PUBLIC" [ take-public-id ] }
98 : take-word ( -- string )
99 [ blank? ] take-until ;
101 : take-external-id ( -- external-id )
102 take-word (take-external-id) ;