add a size-on-disk slot to file-info, the each-file combinator now works better, add a path>sizes word
parent
74d352434c
commit
5c236d6585
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ) ;
|
||||
|
|
Loading…
Reference in New Issue