! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators destructors io io.backend
-io.encodings.binary io.files io.pathnames kernel namespaces
-sequences system vocabs.loader fry ;
+USING: accessors combinators combinators.short-circuit
+continuations destructors fry io io.backend io.encodings.binary
+io.files io.pathnames kernel namespaces sequences system vocabs ;
IN: io.directories
: set-current-directory ( path -- )
- (normalize-path) current-directory set ;
+ absolute-path current-directory set ;
: with-directory ( path quot -- )
- [ (normalize-path) current-directory ] dip with-variable ; inline
+ [ absolute-path current-directory ] dip with-variable ; inline
+
+: with-resource-directory ( quot -- )
+ [ "resource:" ] dip with-directory ; inline
! Creating directories
HOOK: make-directory io-backend ( path -- )
: make-directories ( path -- )
- normalize-path trim-right-separators {
- { [ dup "." = ] [ ] }
- { [ dup root-directory? ] [ ] }
- { [ dup empty? ] [ ] }
- { [ dup exists? ] [ ] }
- [
- dup parent-directory make-directories
- dup make-directory
- ]
- } cond drop ;
+ normalize-path trim-tail-separators dup {
+ [ "." = ]
+ [ root-directory? ]
+ [ empty? ]
+ [ exists? ]
+ } 1|| [
+ dup parent-directory make-directories
+ dup make-directory
+ ] unless drop ;
! Listing directories
TUPLE: directory-entry name type ;
-HOOK: >directory-entry os ( byte-array -- directory-entry )
+C: <directory-entry> directory-entry
HOOK: (directory-entries) os ( path -- seq )
: directory-entries ( path -- seq )
normalize-path
(directory-entries)
- [ name>> { "." ".." } member? not ] filter ;
-
+ [ name>> { "." ".." } member? ] reject ;
+
: directory-files ( path -- seq )
- directory-entries [ name>> ] map ;
+ directory-entries [ name>> ] map! ;
+
+: with-directory-entries ( path quot -- )
+ '[ "" directory-entries @ ] with-directory ; inline
: with-directory-files ( path quot -- )
'[ "" directory-files @ ] with-directory ; inline
HOOK: delete-directory io-backend ( path -- )
+: ?delete-file ( path -- )
+ '[ _ delete-file ] ignore-errors ;
+
: to-directory ( from to -- from to' )
over file-name append-path ;
{
{ [ os unix? ] [ "io.directories.unix" require ] }
{ [ os windows? ] [ "io.directories.windows" require ] }
-} cond
\ No newline at end of file
+} cond