basis/xml/autoencoding/autoencoding.factor

   1 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel namespaces xml.name io.encodings.utf8 xml.elements
   4 io.encodings.utf16 xml.tokenize xml.state math ascii sequences
   5 io.encodings.string io.encodings combinators ;
   6 IN: xml.autoencoding
   7
   8 : continue-make-tag ( str -- tag )
   9     parse-name-starting middle-tag end-tag ;
  10
  11 : start-utf16le ( -- tag )
  12     utf16le decode-input-if
  13     CHAR: ? expect
  14     0 expect check instruct ;
  15
  16 : 10xxxxxx? ( ch -- ? )
  17     -6 shift 3 bitand 2 = ;
  18
  19 : start<name ( ch -- tag )
  20     ascii?
  21     [ utf8 decode-input-if next make-tag ] [
  22         next
  23         [ get-next 10xxxxxx? not ] take-until
  24         get-char suffix utf8 decode
  25         utf8 decode-input-if next
  26         continue-make-tag
  27     ] if ;
  28
  29 : start< ( -- tag )
  30     get-next {
  31         { 0 [ next next start-utf16le ] }
  32         { CHAR: ? [ check next next instruct ] } ! XML prolog parsing sets the encoding
  33         { CHAR: ! [ check utf8 decode-input next next direct ] }
  34         [ check start<name ]
  35     } case ;
  36
  37 : skip-utf8-bom ( -- tag )
  38     "\u0000bb\u0000bf" expect utf8 decode-input
  39     CHAR: < expect check make-tag ;
  40
  41 : decode-expecting ( encoding string -- tag )
  42     [ decode-input-if next ] [ expect-string ] bi* check make-tag ;
  43
  44 : start-utf16be ( -- tag )
  45     utf16be "<" decode-expecting ;
  46
  47 : skip-utf16le-bom ( -- tag )
  48     utf16le "\u0000fe<" decode-expecting ;
  49
  50 : skip-utf16be-bom ( -- tag )
  51     utf16be "\u0000ff<" decode-expecting ;
  52
  53 : start-document ( -- tag )
  54     get-char {
  55         { CHAR: < [ start< ] }
  56         { 0 [ start-utf16be ] }
  57         { HEX: EF [ skip-utf8-bom ] }
  58         { HEX: FF [ skip-utf16le-bom ] }
  59         { HEX: FE [ skip-utf16be-bom ] }
  60         { f [ "" ] }
  61         [ drop utf8 decode-input-if f ]
  62         ! Same problem as with <e`>, in the case of XML chunks?
  63     } case check ;
  64