1 ! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators destructors io io.backend
4 io.encodings.binary io.files io.files.types io.pathnames
5 kernel namespaces sequences system vocabs.loader fry ;
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 ! Creating directories
15 HOOK: make-directory io-backend ( path -- )
17 : make-directories ( path -- )
18 normalize-path trim-tail-separators {
20 { [ dup root-directory? ] [ ] }
21 { [ dup empty? ] [ ] }
22 { [ dup exists? ] [ ] }
24 dup parent-directory make-directories
30 TUPLE: directory-entry name type ;
32 HOOK: >directory-entry os ( byte-array -- directory-entry )
34 HOOK: (directory-entries) os ( path -- seq )
36 : directory-entries ( path -- seq )
39 [ name>> { "." ".." } member? not ] filter ;
41 : directory-files ( path -- seq )
42 directory-entries [ name>> ] map ;
44 : directory-tree-files ( path -- seq )
47 dup type>> +directory+ =
49 [ append-path directory-tree-files ]
50 [ [ prepend-path ] curry map ]
52 ] [ nip name>> 1array ] if
55 : with-directory-entries ( path quot -- )
56 '[ "" directory-entries @ ] with-directory ; inline
58 : with-directory-files ( path quot -- )
59 '[ "" directory-files @ ] with-directory ; inline
61 : with-directory-tree-files ( path quot -- )
62 '[ "" directory-tree-files @ ] with-directory ; inline
65 HOOK: touch-file io-backend ( path -- )
68 HOOK: delete-file io-backend ( path -- )
70 HOOK: delete-directory io-backend ( path -- )
72 : to-directory ( from to -- from to' )
73 over file-name append-path ;
75 ! Moving and renaming files
76 HOOK: move-file io-backend ( from to -- )
78 : move-file-into ( from to -- )
79 to-directory move-file ;
81 : move-files-into ( files to -- )
82 '[ _ move-file-into ] each ;
85 HOOK: copy-file io-backend ( from to -- )
88 dup parent-directory make-directories
89 binary <file-writer> [
90 swap binary <file-reader> [
95 : copy-file-into ( from to -- )
96 to-directory copy-file ;
98 : copy-files-into ( files to -- )
99 '[ _ copy-file-into ] each ;
102 { [ os unix? ] [ "io.directories.unix" require ] }
103 { [ os windows? ] [ "io.directories.windows" require ] }