diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor
index 818899606d..fb172b78e0 100644
--- a/basis/io/directories/search/search-docs.factor
+++ b/basis/io/directories/search/search-docs.factor
@@ -41,11 +41,11 @@ HELP: find-all-files
{ "path" "a pathname string" } { "quot" quotation }
{ "paths/f" "a sequence of pathname strings or f" }
}
-{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;
+{ $description "Recursively finds all files in the input directory matching the predicate quotation." } ;
HELP: find-all-in-directories
{ $values
- { "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+ { "directories" "a sequence of directory paths" } { "quot" quotation }
{ "paths/f" "a sequence of pathname strings or f" }
}
{ $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor
index 87fbf67110..440c3a0326 100755
--- a/basis/io/directories/search/search.factor
+++ b/basis/io/directories/search/search.factor
@@ -3,7 +3,7 @@
USING: accessors arrays continuations deques dlists fry
io.directories io.files io.files.info io.pathnames kernel
sequences system vocabs.loader locals math namespaces
-sorting assocs calendar threads ;
+sorting assocs calendar threads io math.parser ;
IN: io.directories.search
: qualified-directory-entries ( path -- seq )
@@ -13,12 +13,17 @@ IN: io.directories.search
: qualified-directory-files ( path -- seq )
dup directory-files [ append-path ] with map ;
+: with-qualified-directory-files ( path quot -- )
+ '[ "" qualified-directory-files @ ] with-directory ; inline
+
+: with-qualified-directory-entries ( path quot -- )
+ '[ "" qualified-directory-entries @ ] with-directory ; inline
+
<PRIVATE
TUPLE: directory-iterator path bfs queue ;
-: push-directory ( path iter -- )
- [ dup directory-entry? [ name>> ] when ] dip
+: push-directory-entries ( path iter -- )
[ qualified-directory-entries ] dip '[
_ [ queue>> ] [ bfs>> ] bi
[ push-front ] [ push-back ] if
@@ -26,77 +31,86 @@ TUPLE: directory-iterator path bfs queue ;
: <directory-iterator> ( path bfs? -- iterator )
<dlist> directory-iterator boa
- dup path>> over push-directory ;
+ dup path>> over push-directory-entries ;
-: next-file ( iter -- file/f )
+: next-directory-entry ( iter -- directory-entry/f )
dup queue>> deque-empty? [ drop f ] [
- dup queue>> pop-back dup directory?
- [ over push-directory next-file ]
- [ nip name>> ] if
- ] if ;
+ dup queue>> pop-back
+ dup directory?
+ [ name>> over push-directory-entries next-directory-entry ]
+ [ nip ] if
+ ] if ; recursive
-:: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
- iter next-file [
- quot call [ iter quot iterate-directory ] unless*
+:: iterate-directory-entries ( iter quot -- directory-entry/f )
+ iter next-directory-entry [
+ quot call( obj -- obj ) [ iter quot iterate-directory-entries ] unless*
] [
f
] if* ; inline recursive
+: iterate-directory ( iter quot -- path/f )
+ [ name>> ] prepose iterate-directory-entries ;
+
+: setup-traversal ( path bfs quot -- iterator quot' )
+ [ <directory-iterator> ] dip [ f ] compose ;
+
PRIVATE>
-: each-file ( path bfs? quot: ( obj -- ) -- )
- [ <directory-iterator> ] dip
- [ f ] compose iterate-directory drop ; inline
+: each-file ( path bfs? quot -- )
+ setup-traversal [ name>> ] prepose
+ iterate-directory-entries drop ; inline
-: recursive-directory ( path bfs? -- paths )
+: each-directory-entry ( path bfs? quot -- )
+ setup-traversal iterate-directory-entries drop ;
+
+: recursive-directory-files ( path bfs? -- paths )
[ ] accumulator [ each-file ] dip ;
-: find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
+: recursive-directory-entries ( path bfs? -- paths )
+ [ ] accumulator [ each-directory-entry ] dip ;
+
+: find-file ( path bfs? quot -- path/f )
'[
_ _ _ [ <directory-iterator> ] dip
[ keep and ] curry iterate-directory
- ] [ drop f ] recover ; inline
+ ] [ drop f ] recover ;
-: find-all-files ( path quot: ( obj -- ? ) -- paths/f )
- f swap
+: find-all-files ( path quot -- paths/f )
'[
- _ _ _ [ <directory-iterator> ] dip
+ _ _ [ f <directory-iterator> ] dip
pusher [ [ f ] compose iterate-directory drop ] dip
- ] [ drop f ] recover ; inline
+ ] [ drop f ] recover ;
-ERROR: file-not-found ;
+ERROR: file-not-found path bfs? quot ;
-: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f )
+: find-file-throws ( path bfs? quot -- path )
+ 3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ;
+
+: find-in-directories ( directories bfs? quot -- path'/f )
'[
- _ [ _ _ find-file [ file-not-found ] unless* ] attempt-all
+ _ [ _ _ find-file-throws ] attempt-all
] [
drop f
- ] recover ; inline
+ ] recover ;
-: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
- '[ _ _ find-all-files ] map concat ; inline
+: find-all-in-directories ( directories quot -- paths/f )
+ '[ _ find-all-files ] map concat ;
-: with-qualified-directory-files ( path quot -- )
- '[ "" qualified-directory-files @ ] with-directory ; inline
-
-: with-qualified-directory-entries ( path quot -- )
- '[ "" qualified-directory-entries @ ] with-directory ; inline
+: link-size/0 ( path -- n )
+ [ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
: directory-size ( path -- n )
- 0 swap t [
- [ link-info size-on-disk>> + ] [ 2drop ] recover
- ] each-file ;
+ 0 swap t [ link-size/0 + ] each-file ;
: path>usage ( directory-entry -- name size )
- [ name>> dup ] [ directory? ] bi [
- directory-size
- ] [
- [ link-info size-on-disk>> ] [ 2drop 0 ] recover
- ] if ;
+ [ name>> dup ] [ directory? ] bi
+ [ directory-size ] [ link-size/0 ] if ;
: directory-usage ( path -- assoc )
[
- [ [ path>usage ] [ drop name>> 0 ] recover ] { } map>assoc
+ [
+ [ path>usage ] [ drop name>> 0 ] recover
+ ] { } map>assoc
] with-qualified-directory-entries sort-values ;
os windows? [ "io.directories.search.windows" require ] when