steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-04-24 09:44:46 -05:00
parent b00d81e47b 3b19a26e07
commit 4d678d7436
1 changed files with 26 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
basis/io/directories/search/search.factor
View File

@ -3,18 +3,23 @@
USING: accessors arrays continuations deques dlists fry USING: accessors arrays continuations deques dlists fry
io.directories io.files io.files.info io.pathnames kernel io.directories io.files io.files.info io.pathnames kernel
sequences system vocabs.loader locals math namespaces sequences system vocabs.loader locals math namespaces
sorting assocs ; sorting assocs calendar threads ;
IN: io.directories.search IN: io.directories.search
: qualified-directory-entries ( path -- seq )
dup directory-entries
[ [ append-path ] change-name ] with map ;
: qualified-directory-files ( path -- seq )
dup directory-files [ append-path ] with map ;
<PRIVATE <PRIVATE
TUPLE: directory-iterator path bfs queue ; TUPLE: directory-iterator path bfs queue ;
: qualified-directory ( path -- seq )
dup directory-files [ append-path ] with map ;
: push-directory ( path iter -- ) : push-directory ( path iter -- )
[ qualified-directory ] dip '[ [ dup directory-entry? [ name>> ] when ] dip
[ qualified-directory-entries ] dip '[
_ [ queue>> ] [ bfs>> ] bi _ [ queue>> ] [ bfs>> ] bi
[ push-front ] [ push-back ] if [ push-front ] [ push-back ] if
] each ; ] each ;
@ -25,8 +30,9 @@ TUPLE: directory-iterator path bfs queue ;
: next-file ( iter -- file/f ) : next-file ( iter -- file/f )
dup queue>> deque-empty? [ drop f ] [ dup queue>> deque-empty? [ drop f ] [
dup queue>> pop-back dup link-info directory? dup queue>> pop-back dup directory?
[ over push-directory next-file ] [ nip ] if [ over push-directory next-file ]
[ nip name>> ] if
] if ; ] if ;
:: iterate-directory ( iter quot: ( obj -- ? ) -- obj ) :: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
@ -71,29 +77,26 @@ ERROR: file-not-found ;
'[ _ _ find-all-files ] map concat ; inline '[ _ _ find-all-files ] map concat ; inline
: with-qualified-directory-files ( path quot -- ) : with-qualified-directory-files ( path quot -- )
'[ '[ "" qualified-directory-files @ ] with-directory ; inline
"" directory-files current-directory get
'[ _ prepend-path ] map @
] with-directory ; inline
: with-qualified-directory-entries ( path quot -- ) : with-qualified-directory-entries ( path quot -- )
'[ '[ "" qualified-directory-entries @ ] with-directory ; inline
"" directory-entries current-directory get
'[ [ _ prepend-path ] change-name ] map @
] with-directory ; inline
: directory-size ( path -- n ) : directory-size ( path -- n )
0 swap t [ link-info size-on-disk>> + ] each-file ; 0 swap t [
[ link-info size-on-disk>> + ] [ 2drop ] recover
] each-file ;
: path>usage ( directory-entry -- name size )
[ name>> dup ] [ directory? ] bi [
directory-size
] [
[ link-info size-on-disk>> ] [ 2drop 0 ] recover
] if ;
: directory-usage ( path -- assoc ) : directory-usage ( path -- assoc )
[ [
[ [ [ path>usage ] [ drop name>> 0 ] recover ] { } map>assoc
[ name>> dup ] [ directory? ] bi [
directory-size
] [
link-info size-on-disk>>
] if
] { } map>assoc
] with-qualified-directory-entries sort-values ; ] with-qualified-directory-entries sort-values ;
os windows? [ "io.directories.search.windows" require ] when os windows? [ "io.directories.search.windows" require ] when