add a size-on-disk slot to file-info, the each-file combinator now works better, add a path>sizes word

db4
Doug Coleman 2009-04-20 16:52:18 -05:00
parent 74d352434c
commit 5c236d6585
5 changed files with 66 additions and 14 deletions

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays continuations deques dlists fry
io.directories io.files io.files.info io.pathnames kernel
sequences system vocabs.loader ;
sequences system vocabs.loader locals math namespaces
sorting assocs ;
IN: io.directories.search
<PRIVATE
@ -13,10 +14,10 @@ TUPLE: directory-iterator path bfs queue ;
dup directory-files [ append-path ] with map ;
: push-directory ( path iter -- )
[ qualified-directory ] dip [
[ queue>> ] [ bfs>> ] bi
[ qualified-directory ] dip '[
_ [ queue>> ] [ bfs>> ] bi
[ push-front ] [ push-back ] if
] curry each ;
] each ;
: <directory-iterator> ( path bfs? -- iterator )
<dlist> directory-iterator boa
@ -28,12 +29,11 @@ TUPLE: directory-iterator path bfs queue ;
[ over push-directory next-file ] [ nip ] if
] if ;
: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
over next-file [
over call
[ 2nip ] [ iterate-directory ] if*
:: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
iter next-file [
quot call [ iter quot iterate-directory ] unless*
] [
2drop f
f
] if* ; inline recursive
PRIVATE>
@ -70,4 +70,30 @@ ERROR: file-not-found ;
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
'[ _ _ find-all-files ] map concat ; inline
: with-qualified-directory-files ( path quot -- )
'[
"" directory-files current-directory get
'[ _ prepend-path ] map @
] with-directory ; inline
: with-qualified-directory-entries ( path quot -- )
'[
"" directory-entries current-directory get
'[ [ _ prepend-path ] change-name ] map @
] with-directory ; inline
: directory-size ( path -- n )
0 swap t [ file-info size-on-disk>> + ] each-file ;
: path>sizes ( path -- assoc )
[
[
[ name>> dup ] [ directory? ] bi [
directory-size
] [
file-info size-on-disk>>
] if
] { } map>assoc
] with-qualified-directory-entries sort-values ;
os windows? [ "io.directories.search.windows" require ] when

View File

@ -5,7 +5,7 @@ vocabs.loader io.files.types ;
IN: io.files.info
! File info
TUPLE: file-info type size permissions created modified
TUPLE: file-info type size size-on-disk permissions created modified
accessed ;
HOOK: file-info os ( path -- info )
@ -25,4 +25,4 @@ HOOK: file-system-info os ( path -- file-system-info )
{
{ [ os unix? ] [ "io.files.info.unix." os name>> append ] }
{ [ os windows? ] [ "io.files.info.windows" ] }
} cond require
} cond require

View File

@ -80,6 +80,7 @@ M: unix stat>file-info ( stat -- file-info )
[ stat-st_rdev >>rdev ]
[ stat-st_blocks >>blocks ]
[ stat-st_blksize >>blocksize ]
[ drop blocks>> blocksize>> * >>size-on-disk ]
} cleave ;
: n>file-type ( n -- type )

View File

@ -5,11 +5,33 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors
calendar ascii combinators.short-circuit ;
calendar ascii combinators.short-circuit locals ;
IN: io.files.info.windows
:: round-up-to ( n multiple -- n' )
n multiple rem dup 0 = [
drop n
] [
multiple swap - n +
] if ;
TUPLE: windows-file-info < file-info attributes ;
: get-compressed-file-size ( path -- n )
"DWORD" <c-object> [ GetCompressedFileSize ] keep
over INVALID_FILE_SIZE = [
win32-error-string throw
] [
*uint >64bit
] if ;
: set-windows-size-on-disk ( file-info path -- file-info )
over attributes>> +compressed+ swap member? [
get-compressed-file-size
] [
drop dup size>> 4096 round-up-to
] if >>size-on-disk ;
: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
[ \ windows-file-info new ] dip
{
@ -79,7 +101,9 @@ TUPLE: windows-file-info < file-info attributes ;
] if ;
M: windows file-info ( path -- info )
normalize-path get-file-information-stat ;
normalize-path
[ get-file-information-stat ]
[ set-windows-size-on-disk ] bi ;
M: windows link-info ( path -- info )
file-info ;

View File

@ -1139,7 +1139,8 @@ FUNCTION: BOOL GetCommState ( HANDLE hFile, LPDCB lpDCB ) ;
! FUNCTION: GetCommTimeouts
! FUNCTION: GetComPlusPackageInstallStatus
! FUNCTION: GetCompressedFileSizeA
! FUNCTION: GetCompressedFileSizeW
FUNCTION: DWORD GetCompressedFileSizeW ( LPCTSTR lpFileName, LPDWORD lpFileSizeHigh ) ;
ALIAS: GetCompressedFileSize GetCompressedFileSizeW
FUNCTION: BOOL GetComputerNameW ( LPTSTR lpBuffer, LPDWORD lpnSize ) ;
ALIAS: GetComputerName GetComputerNameW
FUNCTION: BOOL GetComputerNameExW ( COMPUTER_NAME_FORMAT NameType, LPTSTR lpBuffer, LPDWORD lpnSize ) ;