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 d12adc5f41592de0e1e9ccda1638a754c34fc20e..eee03c78520e5e0491c406fc120a771df02918e4 100644 (file)
--- a/basis/io/directories/directories.factor
+++ b/basis/io/directories/directories.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators destructors io io.backend
-io.encodings.binary io.files io.files.types 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 -- )
@@ -11,46 +11,37 @@ IN: io.directories
 : with-directory ( path quot -- )
     [ 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-tail-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-tree-files ( path -- seq )
-    dup directory-entries
-    [
-        dup type>> +directory+ =
-        [ name>>
-            [ append-path directory-tree-files ]
-            [ [ prepend-path ] curry map ]
-            [ prefix ] tri
-        ] [ nip name>> 1array ] if
-    ] with map concat ;
+    directory-entries [ name>> ] map! ;
 
 : with-directory-entries ( path quot -- )
     '[ "" directory-entries @ ] with-directory ; inline
@@ -58,9 +49,6 @@ HOOK: (directory-entries) os ( path -- seq )
 : with-directory-files ( path quot -- )
     '[ "" directory-files @ ] with-directory ; inline
 
-: with-directory-tree-files ( path quot -- )
-    '[ "" directory-tree-files @ ] with-directory ; inline
-
 ! Touching files
 HOOK: touch-file io-backend ( path -- )
 
@@ -69,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 ;