diff --git a/basis/io/unix/files/macosx/macosx.factor b/basis/io/unix/files/macosx/macosx.factor index 322358ba14..397145c9ae 100644 --- a/basis/io/unix/files/macosx/macosx.factor +++ b/basis/io/unix/files/macosx/macosx.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.strings combinators grouping io.encodings.utf8 io.files kernel math sequences -system unix io.unix.files +system unix io.unix.files specialized-arrays.direct.uint arrays unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx ; IN: io.unix.files.macosx @@ -33,7 +33,7 @@ M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-i [ statfs64-f_bavail >>blocks-available ] [ statfs64-f_files >>files ] [ statfs64-f_ffree >>files-free ] - [ statfs64-f_fsid >>id ] + [ statfs64-f_fsid 2 >array >>id ] [ statfs64-f_owner >>owner ] [ statfs64-f_type >>type-id ] [ statfs64-f_flags >>flags ] diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index 894ddc83c6..664727dbdb 100755 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -5,7 +5,7 @@ io.encodings.utf16n io.ports io.windows kernel math splitting fry alien.strings windows windows.kernel32 windows.time calendar combinators math.functions sequences namespaces make words symbols system destructors accessors math.bitwise continuations -windows.errors arrays byte-arrays ; +windows.errors arrays byte-arrays generalizations ; IN: io.windows.files : open-file ( path access-mode create-mode flags -- handle ) @@ -117,7 +117,7 @@ M: windows delete-directory ( path -- ) : find-first-file ( path -- WIN32_FIND_DATA handle ) "WIN32_FIND_DATA" tuck FindFirstFile - [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep ; + [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; : find-next-file ( path -- WIN32_FIND_DATA/f ) "WIN32_FIND_DATA" tuck @@ -257,13 +257,15 @@ M: winnt link-info ( path -- info ) HOOK: root-directory os ( string -- string' ) -: file-system-type ( normalized-path -- str ) - MAX_PATH 1+ - MAX_PATH 1+ - "DWORD" "DWORD" "DWORD" - MAX_PATH 1+ - MAX_PATH 1+ - [ GetVolumeInformation win32-error=0/f ] 2keep drop +: volume-information ( normalized-path -- volume-name volume-serial max-component flags type ) + MAX_PATH 1+ [ ] keep + "DWORD" + "DWORD" + "DWORD" + MAX_PATH 1+ [ ] keep + [ GetVolumeInformation win32-error=0/f ] 7 nkeep + drop 5 nrot drop + [ utf16n alien>string ] 4 ndip utf16n alien>string ; : file-system-space ( normalized-path -- available-space total-space free-space ) @@ -278,14 +280,20 @@ HOOK: root-directory os ( string -- string' ) [ ] } cleave ; +TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ; + M: winnt file-system-info ( path -- file-system-info ) normalize-path root-directory - dup [ file-system-type ] [ file-system-space ] bi - \ file-system-info new + dup [ volume-information ] [ file-system-space ] bi + \ win32-file-system-info new swap *ulonglong >>free-space swap *ulonglong >>total-space swap *ulonglong >>available-space swap >>type + swap *uint >>flags + swap *uint >>max-component + swap *uint >>device-serial + swap >>device-name swap >>mount-point calculate-file-system-info ; @@ -299,16 +307,16 @@ M: winnt file-system-info ( path -- file-system-info ) ] if ; : find-first-volume ( -- string handle ) - MAX_PATH 1+ dup length + MAX_PATH 1+ [ ] keep dupd FindFirstVolume dup win32-error=0/f [ utf16n alien>string ] dip ; : find-next-volume ( handle -- string/f ) - MAX_PATH 1+ dup length - over [ FindNextVolume ] dip swap 0 = [ + MAX_PATH 1+ [ tuck ] keep + FindNextVolume 0 = [ GetLastError ERROR_NO_MORE_FILES = - [ drop f ] [ win32-error ] if + [ drop f ] [ win32-error-string throw ] if ] [ utf16n alien>string ] if ; diff --git a/basis/tools/files/files-tests.factor b/basis/tools/files/files-tests.factor index 4dc4ef23f0..6cbc7d192c 100644 --- a/basis/tools/files/files-tests.factor +++ b/basis/tools/files/files-tests.factor @@ -7,5 +7,4 @@ IN: tools.files.tests [ ] [ "" directory. ] unit-test -[ ] -[ { device-name free-space used-space total-space percent-used } file-systems. ] unit-test +[ ] [ file-systems. ] unit-test diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index a8ce9c9554..ab9ce01c3e 100755 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -58,10 +58,14 @@ percent-used percent-free ; : file-systems-info ( spec -- seq ) file-systems swap '[ _ [ file-system-spec ] with map ] map ; -: file-systems. ( spec -- ) +: print-file-systems ( spec -- ) [ file-systems-info ] [ [ unparse ] map ] bi prefix simple-table. ; +: file-systems. ( -- ) + { device-name free-space used-space total-space percent-used } + print-file-systems ; + { { [ os unix? ] [ "tools.files.unix" ] } { [ os windows? ] [ "tools.files.windows" ] }