io.encodings.utf7: implementation of decoding for new codec utf7
parent
b5eae48068
commit
900c670894
|
@ -0,0 +1,31 @@
|
||||||
|
USING:
|
||||||
|
io.encodings.string io.encodings.utf7
|
||||||
|
kernel
|
||||||
|
sequences
|
||||||
|
strings
|
||||||
|
tools.test ;
|
||||||
|
IN: io.encodings.utf7.tests
|
||||||
|
|
||||||
|
[
|
||||||
|
{
|
||||||
|
"~/b&AOU-g&APg-"
|
||||||
|
"b&AOU-x"
|
||||||
|
"b&APg-x"
|
||||||
|
"test"
|
||||||
|
"Skr&AOQ-ppost"
|
||||||
|
"Ting &- S&AOU-ger"
|
||||||
|
"~/F&APg-lder/mailb&AOU-x &- stuff + more"
|
||||||
|
"~peter/mail/&ZeVnLIqe-/&U,BTFw-"
|
||||||
|
}
|
||||||
|
] [
|
||||||
|
{
|
||||||
|
"~/bågø"
|
||||||
|
"båx"
|
||||||
|
"bøx"
|
||||||
|
"test"
|
||||||
|
"Skräppost"
|
||||||
|
"Ting & Såger"
|
||||||
|
"~/Følder/mailbåx & stuff + more"
|
||||||
|
"~peter/mail/日本語/台北"
|
||||||
|
} [ utf7imap4 encode >string ] map
|
||||||
|
] unit-test
|
|
@ -0,0 +1,58 @@
|
||||||
|
USING:
|
||||||
|
accessors
|
||||||
|
arrays
|
||||||
|
ascii
|
||||||
|
assocs
|
||||||
|
base64
|
||||||
|
byte-arrays
|
||||||
|
fry
|
||||||
|
io
|
||||||
|
io.encodings io.encodings.string io.encodings.utf16
|
||||||
|
kernel
|
||||||
|
sequences
|
||||||
|
splitting
|
||||||
|
strings ;
|
||||||
|
IN: io.encodings.utf7
|
||||||
|
|
||||||
|
SINGLETON: utf7
|
||||||
|
SINGLETON: utf7imap4
|
||||||
|
|
||||||
|
! This map encodes the difference between standard utf7 and the
|
||||||
|
! dialect used by IMAP which wants slashes repladed with commas when
|
||||||
|
! encoding and uses '&' instead of '+' as the escaping character.
|
||||||
|
CONSTANT: dialect-data {
|
||||||
|
{ utf7 { { "" "" } { "+" "-" } } }
|
||||||
|
{ utf7imap4 { { "/" "," } { "&" "-" } } }
|
||||||
|
}
|
||||||
|
|
||||||
|
: >raw-base64 ( byte-array -- str )
|
||||||
|
>string utf16be encode >base64 [ CHAR: = = ] trim-tail ;
|
||||||
|
|
||||||
|
: flush-buffer ( buffer repl-pair surround-pair -- result )
|
||||||
|
rot [ 2drop "" ] [
|
||||||
|
>raw-base64 -rot [ first2 replace ] [ first2 surround ] bi*
|
||||||
|
] if-empty ;
|
||||||
|
|
||||||
|
: escaped-char ( str1 begin end -- str )
|
||||||
|
-rot dupd = [ swap append ] [ nip ] if ;
|
||||||
|
|
||||||
|
: encode-utf7-char ( result buffer dialect-info ch -- result buffer )
|
||||||
|
dup printable? [
|
||||||
|
1string -rot first2
|
||||||
|
[ flush-buffer swapd append swap ]
|
||||||
|
[ nip first2 escaped-char append ] 2bi ""
|
||||||
|
] [ nip suffix ] if ;
|
||||||
|
|
||||||
|
: encode-utf7-string ( str dialect -- str' )
|
||||||
|
{ "" "" } swap dialect-data at [
|
||||||
|
'[ [ first2 ] dip _ swap encode-utf7-char 2array ] reduce
|
||||||
|
] [
|
||||||
|
[ first2 ] dip first2 flush-buffer append
|
||||||
|
] bi ;
|
||||||
|
|
||||||
|
: stream-write-utf7 ( string stream encoding -- )
|
||||||
|
swapd encode-utf7-string >byte-array swap stream-write ;
|
||||||
|
|
||||||
|
M: utf7 encode-string stream-write-utf7 ;
|
||||||
|
|
||||||
|
M: utf7imap4 encode-string stream-write-utf7 ;
|
Loading…
Reference in New Issue