From 8d5f4714fad2086f5a1e3e8089a560e824c34713 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 16 Feb 2008 16:25:45 -0600 Subject: [PATCH] Core I/O changes for encodings --- core/io/encodings/ascii/ascii.factor | 13 ++++++++ core/io/encodings/binary/binary.factor | 5 ++-- core/io/encodings/encodings.factor | 7 +++-- core/io/encodings/latin1/latin1.factor | 10 +++---- core/io/files/files-docs.factor | 38 +++++++++++++++++------- core/io/files/files.factor | 22 +++++++------- core/io/io-tests.factor | 4 +-- core/io/streams/lines/lines-tests.factor | 4 +-- 8 files changed, 67 insertions(+), 36 deletions(-) create mode 100644 core/io/encodings/ascii/ascii.factor diff --git a/core/io/encodings/ascii/ascii.factor b/core/io/encodings/ascii/ascii.factor new file mode 100644 index 0000000000..d767f26cdd --- /dev/null +++ b/core/io/encodings/ascii/ascii.factor @@ -0,0 +1,13 @@ +USING: io io.encodings strings kernel ; +IN: io.encodings.ascii + +: encode-check>= ( string max -- byte-array ) + dupd [ >= ] curry all? [ >byte-array ] [ encoding-error ] if ; + +TUPLE: ascii ; + +M: ascii encode-string + drop 127 encode-check>= ; + +M: ascii decode-step + 3drop over push f f ; diff --git a/core/io/encodings/binary/binary.factor b/core/io/encodings/binary/binary.factor index c4c6237715..17c734b9c8 100644 --- a/core/io/encodings/binary/binary.factor +++ b/core/io/encodings/binary/binary.factor @@ -1,3 +1,2 @@ -USING: kernel io.encodings ; - -TUPLE: binary ; +IN: io.encodings.binary +SYMBOL: binary diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index cab625ad73..4ceae70fae 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: math kernel sequences sbufs vectors namespaces growable strings io classes io.streams.c continuations -io.styles io.streams.nested ; +io.styles io.streams.nested io.encodings.binary ; IN: io.encodings ! Decoding @@ -54,7 +54,10 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) TUPLE: decoded code cr ; : ( stream decoding-class -- decoded-stream ) - construct-empty { set-delegate set-decoded-code } decoded construct ; + dup binary eq? [ drop ] [ + construct-empty { set-delegate set-decoded-code } + decoded construct + ] if ; : cr+ t swap set-line-reader-cr ; inline diff --git a/core/io/encodings/latin1/latin1.factor b/core/io/encodings/latin1/latin1.factor index e6d6281eb6..d6e643fd96 100755 --- a/core/io/encodings/latin1/latin1.factor +++ b/core/io/encodings/latin1/latin1.factor @@ -1,10 +1,10 @@ -USING: io io.encodings strings kernel ; +USING: io io.encodings strings kernel io.encodings.ascii ; IN: io.encodings.latin1 TUPLE: latin1 ; -M: latin1 stream-read delegate stream-read >string ; +M: latin1 encode-string + drop 255 encode-check>= ; -M: latin1 stream-read-until delegate stream-read-until >string ; - -M: latin1 stream-read-partial delegate stream-read-partial >string ; +M: latin1 decode-step + 3drop over push f f ; diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 185fa1436b..839cd2fae0 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -6,6 +6,11 @@ ARTICLE: "file-streams" "Reading and writing files" { $subsection } { $subsection } { $subsection } +{ $subsection with-file-reader } +{ $subsection with-file-writer } +{ $subsection with-file-appender } +{ $subsection file-contents } +{ $subsection file-lines } "Pathname manipulation:" { $subsection parent-directory } { $subsection file-name } @@ -38,33 +43,44 @@ ARTICLE: "file-streams" "Reading and writing files" ABOUT: "file-streams" HELP: -{ $values { "path" "a pathname string" } { "stream" "an input stream" } } -{ $description "Outputs an input stream for reading from the specified pathname." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptors" } + { "stream" "an input stream" } } +{ $description "Outputs an input stream for reading from the specified pathname using the given encoding." } { $errors "Throws an error if the file is unreadable." } ; HELP: -{ $values { "path" "a pathname string" } { "stream" "an output stream" } } -{ $description "Outputs an output stream for writing to the specified pathname. The file's length is truncated to zero." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "stream" "an output stream" } } +{ $description "Outputs an output stream for writing to the specified pathname using the given encoding. The file's length is truncated to zero." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: -{ $values { "path" "a pathname string" } { "stream" "an output stream" } } -{ $description "Outputs an output stream for writing to the specified pathname. The stream begins writing at the end of the file." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "stream" "an output stream" } } +{ $description "Outputs an output stream for writing to the specified pathname using the given encoding. The stream begins writing at the end of the file." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: with-file-reader -{ $values { "path" "a pathname string" } { "quot" "a quotation" } } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } } { $description "Opens a file for reading and calls the quotation using " { $link with-stream } "." } { $errors "Throws an error if the file is unreadable." } ; HELP: with-file-writer -{ $values { "path" "a pathname string" } { "quot" "a quotation" } } -{ $description "Opens a file for writing and calls the quotation using " { $link with-stream } "." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } } +{ $description "Opens a file for writing using the given encoding and calls the quotation using " { $link with-stream } "." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: with-file-appender -{ $values { "path" "a pathname string" } { "quot" "a quotation" } } -{ $description "Opens a file for appending and calls the quotation using " { $link with-stream } "." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } } +{ $description "Opens a file for appending using the given encoding and calls the quotation using " { $link with-stream } "." } +{ $errors "Throws an error if the file cannot be opened for writing." } ; + +HELP: file-lines +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "seq" "an array of strings" } } +{ $description "Opens the file at the given path using the given encoding, and returns a list of the lines in that file." } +{ $errors "Throws an error if the file cannot be opened for writing." } ; + +HELP: file-contents +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "str" "a string" } } +{ $description "Opens the file at the given path using the given encoding, and the contents of that file as a string." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: cwd diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 5a9411aadb..daa5d6df7e 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -15,6 +15,15 @@ HOOK: file-writer* io-backend ( path -- stream ) HOOK: file-appender* io-backend ( path -- stream ) +: ( path encoding -- stream ) + swap file-reader* swap ; + +: ( path encoding -- stream ) + swap file-writer* swap ; + +: ( path encoding -- stream ) + swap file-appender* swap ; + HOOK: delete-file io-backend ( path -- ) HOOK: rename-file io-backend ( from to -- ) @@ -115,8 +124,8 @@ HOOK: copy-file io-backend ( from to -- ) M: object copy-file dup parent-directory make-directories - [ - swap [ + binary [ + swap binary [ swap stream-copy ] with-disposal ] with-disposal ; @@ -140,15 +149,6 @@ C: pathname M: pathname <=> [ pathname-string ] compare ; -: ( path encoding -- stream ) - swap file-reader* swap ; - -: ( path encoding -- stream ) - swap file-writer* swap ; - -: ( path encoding -- stream ) - swap file-appender* swap ; - : file-lines ( path encoding -- seq ) lines ; : file-contents ( path encoding -- str ) diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 23686abab5..00a8078da8 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,5 +1,5 @@ USING: arrays io io.files kernel math parser strings system -tools.test words namespaces ; +tools.test words namespaces io.encodings.ascii ; IN: temporary [ f ] [ @@ -8,7 +8,7 @@ IN: temporary ] unit-test : ( resource -- stream ) - resource-path ; + resource-path binary ascii ; [ "This is a line.\rThis is another line.\r" diff --git a/core/io/streams/lines/lines-tests.factor b/core/io/streams/lines/lines-tests.factor index 64dc7bff3b..e3a4fe886a 100755 --- a/core/io/streams/lines/lines-tests.factor +++ b/core/io/streams/lines/lines-tests.factor @@ -1,9 +1,9 @@ USING: io.streams.lines io.files io.streams.string io -tools.test kernel ; +tools.test kernel io.encodings.ascii ; IN: temporary : ( resource -- stream ) - resource-path ; + resource-path ascii ; [ { } ] [ "/core/io/test/empty-file.txt" lines ]