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

refactoring directory searching

db4
Doug Coleman 2009-04-20 19:01:33 -05:00
parent bf0b1e63c8
commit e8d695e314
1 changed files with 22 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,7 +3,7 @@
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
<PRIVATE <PRIVATE
@ -70,30 +70,35 @@ ERROR: file-not-found ;
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f ) : find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
'[ _ _ find-all-files ] map concat ; inline '[ _ _ find-all-files ] map concat ; inline
: qualified-directory-entries ( path -- seq )
directory-entries
current-directory get '[ [ _ prepend-path ] change-name ] map ;
: qualified-directory-files ( path -- seq )
directory-files
current-directory get '[ _ prepend-path ] map ;
: 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>> ] [ drop 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