factor: trim using lists

[factor.git] / basis / xml / name / name.factor

diff --git a/basis/xml/name/name.factor b/basis/xml/name/name.factor
index 32053b1eb4ea03338dcb6b0fb9f8430e7a9aa786..ab47ac7d415ef5777e9963cf6db5d2e3a9e9c305 100644 (file)
--- a/basis/xml/name/name.factor
+++ b/basis/xml/name/name.factor
@@ -1,8 +1,8 @@
 ! 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 ;
+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
@@ -15,17 +15,17 @@ SYMBOL: ns-stack
     [
         [
             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 ;
@@ -47,26 +47,38 @@ SYMBOL: ns-stack
 
 : 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 ;
@@ -74,3 +86,21 @@ SYMBOL: ns-stack
 : parse-name-starting ( string -- name )
     take-name append interpret-name ;
 
+: take-system-id ( -- system-id )
+    parse-quote <system-id> ;
+
+: take-public-id ( -- public-id )
+    parse-quote parse-quote <public-id> ;
+
+: (take-external-id) ( token -- external-id )
+    pass-blank {
+        { "SYSTEM" [ take-system-id ] }
+        { "PUBLIC" [ take-public-id ] }
+        [ bad-external-id ]
+    } case ;
+
+: take-word ( -- string )
+    [ blank? ] take-until ;
+
+: take-external-id ( -- external-id )
+    take-word (take-external-id) ;