From 7553b816f8f00ba0600d2bcdf901c22660fb495c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 1 Dec 2008 21:20:33 -0600 Subject: [PATCH] add another slot to file-system-info -- available-space, which is what the user can actually use, not what's free on disk --- basis/io/windows/files/files.factor | 22 +++++++++++++--------- core/io/files/files.factor | 2 +- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index 7f84b9d9e5..4c38ee3b12 100755 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -257,9 +257,6 @@ M: winnt link-info ( path -- info ) HOOK: root-directory os ( string -- string' ) -TUPLE: winnt-file-system-info < file-system-info -total-bytes total-free-bytes ; - : file-system-type ( normalized-path -- str ) MAX_PATH 1+ MAX_PATH 1+ @@ -269,21 +266,28 @@ total-bytes total-free-bytes ; [ GetVolumeInformation win32-error=0/f ] 2keep drop utf16n alien>string ; -: file-system-space ( normalized-path -- free-space total-bytes total-free-bytes ) +: file-system-space ( normalized-path -- available-space total-space free-space ) "ULARGE_INTEGER" "ULARGE_INTEGER" "ULARGE_INTEGER" [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; +: calculate-file-system-info ( file-system-info -- file-system-info' ) + { + [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] + [ ] + } cleave ; + M: winnt file-system-info ( path -- file-system-info ) normalize-path root-directory dup [ file-system-type ] [ file-system-space ] bi - \ winnt-file-system-info new - swap *ulonglong >>total-free-bytes - swap *ulonglong >>total-bytes + \ file-system-info new swap *ulonglong >>free-space + swap *ulonglong >>total-space + swap *ulonglong >>available-space swap >>type - swap >>mount-point ; + swap >>mount-point + calculate-file-system-info ; : volume>paths ( string -- array ) 16384 "ushort" tuck dup length @@ -324,7 +328,7 @@ M: winnt file-systems ( -- array ) find-volumes [ volume>paths ] map concat [ [ file-system-info ] - [ drop winnt-file-system-info new swap >>mount-point ] recover + [ drop \ file-system-info new swap >>mount-point ] recover ] map ; : file-times ( path -- timestamp timestamp timestamp ) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index cd1c5d698c..77b37180c6 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -188,7 +188,7 @@ SYMBOL: +unknown+ HOOK: file-systems os ( -- array ) TUPLE: file-system-info device-name mount-point type -free-space used-space total-space ; +available-space free-space used-space total-space ; HOOK: file-system-info os ( path -- file-system-info )