1 ! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: alien.strings io io.backend io.encodings
4 io.pathnames kernel kernel.private namespaces sequences
9 PRIMITIVE: (file-exists?) ( path -- ? )
12 SYMBOL: +retry+ ! just try the operation again without blocking
16 ! Returns an event to wait for which will ensure completion of
18 GENERIC: drain ( port handle -- event/f )
19 GENERIC: refill ( port handle -- event/f )
21 HOOK: wait-for-fd io-backend ( handle event -- )
26 M: file-reader stream-element-type drop +byte+ ; inline
27 M: file-writer stream-element-type drop +byte+ ; inline
29 HOOK: (file-reader) io-backend ( path -- stream )
31 HOOK: (file-writer) io-backend ( path -- stream )
33 HOOK: (file-writer-secure) io-backend ( path -- stream )
35 HOOK: (file-appender) io-backend ( path -- stream )
37 : <file-reader> ( path encoding -- stream )
38 [ normalize-path (file-reader) { file-reader } declare ] dip <decoder> ; inline
40 : <file-writer> ( path encoding -- stream )
41 [ normalize-path (file-writer) { file-writer } declare ] dip <encoder> ; inline
43 : <file-writer-secure> ( path encoding -- stream )
44 [ normalize-path (file-writer-secure) { file-writer } declare ] dip <encoder> ; inline
46 : <file-appender> ( path encoding -- stream )
47 [ normalize-path (file-appender) { file-writer } declare ] dip <encoder> ; inline
49 : file-lines ( path encoding -- seq )
50 <file-reader> stream-lines ;
52 : with-file-reader ( path encoding quot -- )
53 [ <file-reader> ] dip with-input-stream ; inline
55 : file-contents ( path encoding -- seq )
56 <file-reader> stream-contents ;
58 : with-file-writer ( path encoding quot -- )
59 [ <file-writer> ] dip with-output-stream ; inline
61 : with-file-writer-secure ( path encoding quot -- )
62 [ <file-writer-secure> ] dip with-output-stream ; inline
64 : set-file-lines ( seq path encoding -- )
65 [ [ print ] each ] with-file-writer ;
67 : change-file-lines ( ..a path encoding quot: ( ..a seq -- ..b seq' ) -- ..b )
68 '[ file-lines @ ] [ set-file-lines ] 2bi ; inline
70 : set-file-contents ( seq path encoding -- )
71 [ write ] with-file-writer ;
73 : change-file-contents ( ..a path encoding quot: ( ..a seq -- ..b seq' ) -- ..b )
74 '[ file-contents @ ] [ set-file-contents ] 2bi ; inline
76 : with-file-appender ( path encoding quot -- )
77 [ <file-appender> ] dip with-output-stream ; inline
79 : file-exists? ( path -- ? )
80 normalize-path native-string>alien (file-exists?) ;
82 ERROR: no-such-file path ;
84 : check-file-exists ( path -- path )
85 dup file-exists? [ no-such-file ] unless ;
87 : if-file-exists ( ..a path true: ( ..a path -- ..b ) false: ( ..a path -- ..b ) -- ..b )
88 [ dup file-exists? ] 2dip if ; inline
90 : when-file-exists ( ... path quot: ( ... path -- ... ) -- ... )
91 [ drop ] if-file-exists ; inline
93 : unless-file-exists ( ... path quot: ( ... path -- ... ) -- ... )
94 [ drop ] swap if-file-exists ; inline
99 HOOK: cd io-backend ( path -- )
101 HOOK: cwd io-backend ( -- path )
107 : init-resource-path ( -- )
108 OBJ-ARGS special-object [
109 alien>native-string "-resource-path=" ?head [ drop f ] unless
111 [ image-path parent-directory ] unless* "resource-path" set-global ;
114 cwd current-directory set-global
115 OBJ-IMAGE special-object alien>native-string \ image-path set-global
116 OBJ-EXECUTABLE special-object alien>native-string \ vm-path set-global