basis/io/encodings/iana/iana.factor

   1 ! Copyright (C) 2008 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel strings io.files assocs
   4 splitting sequences io namespaces sets
   5 io.encodings.ascii io.encodings.utf8 io.encodings.utf16 ;
   6 IN: io.encodings.iana
   7
   8 <PRIVATE
   9 SYMBOL: n>e-table
  10 SYMBOL: e>n-table
  11 SYMBOL: aliases
  12 PRIVATE>
  13
  14 : name>encoding ( name -- encoding )
  15     n>e-table get-global at ;
  16
  17 : encoding>name ( encoding -- name )
  18     e>n-table get-global at ;
  19
  20 <PRIVATE
  21 : parse-iana ( file -- synonym-set )
  22     utf8 file-lines { "" } split [
  23         [ " " split ] map
  24         [ first { "Name:" "Alias:" } member? ] filter
  25         values { "None" } diff
  26     ] map harvest ;
  27
  28 : make-aliases ( file -- n>e )
  29     parse-iana [ [ first ] [ ] bi ] H{ } map>assoc ;
  30
  31 : initial-n>e ( -- assoc )
  32     H{
  33         { "UTF8" utf8 }
  34         { "utf8" utf8 }
  35         { "utf-8" utf8 }
  36         { "UTF-8" utf8 }
  37     } clone ;
  38
  39 : initial-e>n ( -- assoc )
  40     H{ { utf8 "UTF-8" } } clone ;
  41
  42 PRIVATE>
  43
  44 "vocab:io/encodings/iana/character-sets"
  45 make-aliases aliases set-global
  46
  47 n>e-table [ initial-n>e ] initialize
  48 e>n-table [ initial-e>n ] initialize
  49
  50 : register-encoding ( descriptor name -- )
  51     [
  52         aliases get at [
  53             [ n>e-table get-global set-at ] with each
  54         ] [ "Bad encoding registration" throw ] if*
  55     ] [ swap e>n-table get-global set-at ] 2bi ;
  56
  57 ascii "ANSI_X3.4-1968" register-encoding
  58 utf16be "UTF-16BE" register-encoding
  59 utf16le "UTF-16LE" register-encoding
  60 utf16 "UTF-16" register-encoding