1 ! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators combinators.short-circuit
4 continuations destructors fry io io.backend io.encodings.binary
5 io.files io.pathnames kernel namespaces sequences system vocabs ;
8 : set-current-directory ( path -- )
9 absolute-path current-directory set ;
11 : with-directory ( path quot -- )
12 [ absolute-path current-directory ] dip with-variable ; inline
14 : with-resource-directory ( quot -- )
15 [ "resource:" ] dip with-directory ; inline
17 ! Creating directories
18 HOOK: make-directory io-backend ( path -- )
20 : make-directories ( path -- )
21 normalize-path trim-tail-separators dup {
27 dup parent-directory make-directories
32 TUPLE: directory-entry name type ;
34 HOOK: >directory-entry os ( byte-array -- directory-entry )
36 HOOK: (directory-entries) os ( path -- seq )
38 : directory-entries ( path -- seq )
41 [ name>> { "." ".." } member? not ] filter ;
43 : directory-files ( path -- seq )
44 directory-entries [ name>> ] map! ;
46 : with-directory-entries ( path quot -- )
47 '[ "" directory-entries @ ] with-directory ; inline
49 : with-directory-files ( path quot -- )
50 '[ "" directory-files @ ] with-directory ; inline
53 HOOK: touch-file io-backend ( path -- )
56 HOOK: delete-file io-backend ( path -- )
58 HOOK: delete-directory io-backend ( path -- )
60 : ?delete-file ( path -- )
61 '[ _ delete-file ] ignore-errors ;
63 : to-directory ( from to -- from to' )
64 over file-name append-path ;
66 ! Moving and renaming files
67 HOOK: move-file io-backend ( from to -- )
69 : move-file-into ( from to -- )
70 to-directory move-file ;
72 : move-files-into ( files to -- )
73 '[ _ move-file-into ] each ;
76 HOOK: copy-file io-backend ( from to -- )
79 dup parent-directory make-directories
80 binary <file-writer> [
81 swap binary <file-reader> [
86 : copy-file-into ( from to -- )
87 to-directory copy-file ;
89 : copy-files-into ( files to -- )
90 '[ _ copy-file-into ] each ;
93 { [ os unix? ] [ "io.directories.unix" require ] }
94 { [ os windows? ] [ "io.directories.windows" require ] }