steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add another slot to file-system-info -- available-space, which is what the user can actually use, not what's free on disk

db4
Doug Coleman 2008-12-01 21:20:33 -06:00
parent 463f8bd7f9
commit 7553b816f8
2 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/io/windows/files/files.factor
View File

@ -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+ <byte-array>
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" <c-object>
"ULARGE_INTEGER" <c-object>
"ULARGE_INTEGER" <c-object>
[ 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" <c-array> 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 )

2
core/io/files/files.factor
View File

@ -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 )