add a size-on-disk slot to file-info, the each-file combinator now works better,...

diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor
index 6db83ebca6b43e5f4a23768d95426a6f8635d144..38d8ec957e4510e52efd5ec5b3d0e7ca9cf78133 100755 (executable)
--- 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
 
 <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

diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor
index fd218506128cbe4b464d65f870ab8337a5a11006..5c5d2c93d2f68bf90a858046acc5f114fb45b5da 100644 (file)
--- 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 616f70ccccac90167df568de923247d33c7395e5..d4762a536d2731e7c13e893c4a6f6f528ff95f24 100644 (file)
--- 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 fdff368491eb66a66db778e862c8f65b1eddcef4..81e43f8dd9cd0dd5d2655b7a34f56e926c30e770 100755 (executable)
--- 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" <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 ;

diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 4d3dd81a0e7ef34ac058c40d8e3b770b50fd0f11..1a513df1867728bba1d738437a5776606c576b7c 100755 (executable)
--- 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 ) ;