2009-05-02 14:45:38 -04:00
|
|
|
! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2014-11-23 01:20:58 -05:00
|
|
|
USING: alien.strings continuations init io io.backend
|
|
|
|
io.encodings io.encodings.utf8 io.files.private io.pathnames
|
|
|
|
kernel kernel.private namespaces sequences splitting system ;
|
2008-02-29 00:46:27 -05:00
|
|
|
IN: io.files
|
|
|
|
|
2015-06-25 21:02:03 -04:00
|
|
|
<PRIVATE
|
|
|
|
PRIMITIVE: (exists?) ( path -- ? )
|
|
|
|
PRIVATE>
|
|
|
|
|
2013-10-16 11:34:31 -04:00
|
|
|
SYMBOL: +retry+ ! just try the operation again without blocking
|
|
|
|
SYMBOL: +input+
|
|
|
|
SYMBOL: +output+
|
|
|
|
|
|
|
|
! Returns an event to wait for which will ensure completion of
|
|
|
|
! this request
|
|
|
|
GENERIC: drain ( port handle -- event/f )
|
|
|
|
GENERIC: refill ( port handle -- event/f )
|
|
|
|
|
2013-10-21 16:58:33 -04:00
|
|
|
HOOK: wait-for-fd io-backend ( handle event -- )
|
2013-10-21 12:27:29 -04:00
|
|
|
|
2011-11-09 17:43:39 -05:00
|
|
|
MIXIN: file-reader
|
|
|
|
MIXIN: file-writer
|
|
|
|
|
|
|
|
M: file-reader stream-element-type drop +byte+ ; inline
|
|
|
|
M: file-writer stream-element-type drop +byte+ ; inline
|
|
|
|
|
2008-02-24 02:37:05 -05:00
|
|
|
HOOK: (file-reader) io-backend ( path -- stream )
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-24 02:37:05 -05:00
|
|
|
HOOK: (file-writer) io-backend ( path -- stream )
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-24 02:37:05 -05:00
|
|
|
HOOK: (file-appender) io-backend ( path -- stream )
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-16 17:25:45 -05:00
|
|
|
: <file-reader> ( path encoding -- stream )
|
2011-11-09 17:43:39 -05:00
|
|
|
[ normalize-path (file-reader) { file-reader } declare ] dip <decoder> ; inline
|
2008-02-16 17:25:45 -05:00
|
|
|
|
|
|
|
: <file-writer> ( path encoding -- stream )
|
2011-11-09 17:43:39 -05:00
|
|
|
[ normalize-path (file-writer) { file-writer } declare ] dip <encoder> ; inline
|
2008-02-16 17:25:45 -05:00
|
|
|
|
|
|
|
: <file-appender> ( path encoding -- stream )
|
2011-11-09 17:43:39 -05:00
|
|
|
[ normalize-path (file-appender) { file-writer } declare ] dip <encoder> ; inline
|
2008-02-16 17:25:45 -05:00
|
|
|
|
2008-03-25 20:50:39 -04:00
|
|
|
: file-lines ( path encoding -- seq )
|
2009-05-01 11:41:27 -04:00
|
|
|
<file-reader> stream-lines ;
|
2008-03-25 20:50:39 -04:00
|
|
|
|
|
|
|
: with-file-reader ( path encoding quot -- )
|
2008-11-23 03:44:56 -05:00
|
|
|
[ <file-reader> ] dip with-input-stream ; inline
|
2008-03-25 20:50:39 -04:00
|
|
|
|
2009-01-29 01:08:40 -05:00
|
|
|
: file-contents ( path encoding -- seq )
|
2009-05-01 11:41:27 -04:00
|
|
|
<file-reader> stream-contents ;
|
2008-03-25 20:50:39 -04:00
|
|
|
|
|
|
|
: with-file-writer ( path encoding quot -- )
|
2008-11-23 03:44:56 -05:00
|
|
|
[ <file-writer> ] dip with-output-stream ; inline
|
2008-03-25 20:50:39 -04:00
|
|
|
|
|
|
|
: set-file-lines ( seq path encoding -- )
|
|
|
|
[ [ print ] each ] with-file-writer ;
|
|
|
|
|
2015-08-04 18:03:37 -04:00
|
|
|
: change-file-lines ( path encoding quot -- )
|
|
|
|
[ [ file-lines ] dip call ]
|
|
|
|
[ drop set-file-lines ] 3bi ; inline
|
|
|
|
|
2009-01-29 01:08:40 -05:00
|
|
|
: set-file-contents ( seq path encoding -- )
|
2008-03-25 20:50:39 -04:00
|
|
|
[ write ] with-file-writer ;
|
|
|
|
|
2015-08-04 18:03:37 -04:00
|
|
|
: change-file-contents ( path encoding quot -- )
|
|
|
|
[ [ file-contents ] dip call ]
|
|
|
|
[ drop set-file-contents ] 3bi ; inline
|
|
|
|
|
2008-03-25 20:50:39 -04:00
|
|
|
: with-file-appender ( path encoding quot -- )
|
2008-11-23 03:44:56 -05:00
|
|
|
[ <file-appender> ] dip with-output-stream ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-05-02 14:45:38 -04:00
|
|
|
: exists? ( path -- ? )
|
|
|
|
normalize-path native-string>alien (exists?) ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-12-14 21:03:00 -05:00
|
|
|
! Current directory
|
2008-04-03 19:34:47 -04:00
|
|
|
<PRIVATE
|
|
|
|
|
2008-02-27 15:59:15 -05:00
|
|
|
HOOK: cd io-backend ( path -- )
|
|
|
|
|
|
|
|
HOOK: cwd io-backend ( -- path )
|
|
|
|
|
2008-03-26 16:24:54 -04:00
|
|
|
M: object cwd ( -- path ) "." ;
|
|
|
|
|
2008-04-03 19:34:47 -04:00
|
|
|
PRIVATE>
|
|
|
|
|
2012-03-27 19:58:12 -04:00
|
|
|
: init-resource-path ( -- )
|
2015-08-22 12:22:28 -04:00
|
|
|
OBJ-ARGS special-object [
|
|
|
|
alien>native-string "-resource-path=" ?head [ drop f ] unless
|
|
|
|
] map-find drop
|
2015-07-20 03:17:09 -04:00
|
|
|
[ image-path parent-directory ] unless* "resource-path" set-global ;
|
2012-03-27 19:58:12 -04:00
|
|
|
|
2008-09-17 23:40:51 -04:00
|
|
|
[
|
|
|
|
cwd current-directory set-global
|
2015-07-20 03:17:09 -04:00
|
|
|
OBJ-IMAGE special-object alien>native-string cwd prepend-path \ image-path set-global
|
2015-07-20 03:03:00 -04:00
|
|
|
OBJ-EXECUTABLE special-object alien>native-string cwd prepend-path \ vm-path set-global
|
2012-03-27 19:58:12 -04:00
|
|
|
init-resource-path
|
2009-10-19 22:17:02 -04:00
|
|
|
] "io.files" add-startup-hook
|