use reject instead of [ ... not ] filter.

[factor.git] / basis / io / directories / directories.factor

diff --git a/basis/io/directories/directories.factor b/basis/io/directories/directories.factor
index 0b8fa13791118b261c10bc3676e403c078fa8578..eee03c78520e5e0491c406fc120a771df02918e4 100644 (file)
--- a/basis/io/directories/directories.factor
+++ b/basis/io/directories/directories.factor
@@ -1,45 +1,50 @@
 ! 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
@@ -52,6 +57,9 @@ HOOK: delete-file io-backend ( path -- )
 
 HOOK: delete-directory io-backend ( path -- )
 
+: ?delete-file ( path -- )
+    '[ _ delete-file ] ignore-errors ;
+
 : to-directory ( from to -- from to' )
     over file-name append-path ;
 
@@ -83,4 +91,5 @@ M: object copy-file
 
 {
     { [ os unix? ] [ "io.directories.unix" require ] }
-} cond
\ No newline at end of file
+    { [ os windows? ] [ "io.directories.windows" require ] }
+} cond