From: Doug Coleman Date: Mon, 20 Apr 2009 21:52:18 +0000 (-0500) Subject: add a size-on-disk slot to file-info, the each-file combinator now works better,... X-Git-Tag: 0.94~2000^2~9 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=5c236d6585afe7751263ca4d9c74722ef6e17ea7 add a size-on-disk slot to file-info, the each-file combinator now works better, add a path>sizes word --- diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 6db83ebca6..38d8ec957e 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -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 > ] [ bfs>> ] bi + [ qualified-directory ] dip '[ + _ [ queue>> ] [ bfs>> ] bi [ push-front ] [ push-back ] if - ] curry each ; + ] each ; : ( path bfs? -- iterator ) 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 diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index fd21850612..5c5d2c93d2 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -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 \ No newline at end of file +} cond require diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index 616f70cccc..d4762a536d 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -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 ) diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index fdff368491..81e43f8dd9 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -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" [ 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 ; diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 4d3dd81a0e..1a513df186 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -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 ) ;