Merge branch 'master' of git://factorcode.org/git/factor

basis/io/windows/files/files.factor

@@ -276,18 +276,31 @@ M: winnt file-system-info ( path -- file-system-info )
         swap >>type
         swap >>mount-point ;
 
+: volume>paths ( string -- array )
+    16384 "ushort" <c-array> tuck dup length
+    0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
+        win32-error-string throw
+    ] [
+        *uint "ushort" heap-size * head
+        utf16n alien>string CHAR: \0 split
+    ] if ;
+
 : find-first-volume ( -- string handle )
     MAX_PATH 1+ <byte-array> dup length
     dupd
     FindFirstVolume dup win32-error=0/f
     [ utf16n alien>string ] dip ;
 
-: find-next-volume ( handle -- string )
+: find-next-volume ( handle -- string/f )
     MAX_PATH 1+ <byte-array> dup length
-    [ FindNextVolume win32-error=0/f ] 2keep drop
+    over [ FindNextVolume ] dip swap 0 = [
-    utf16n alien>string ;
+        GetLastError ERROR_NO_MORE_FILES =
+        [ drop f ] [ win32-error ] if
+    ] [
+        utf16n alien>string
+    ] if ;
 
-: mounted ( -- array )
+: find-volumes ( -- array )
     find-first-volume
     [
         '[
@@ -298,6 +311,13 @@ M: winnt file-system-info ( path -- file-system-info )
         ]
     ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ;
 
+M: winnt file-systems ( -- array )
+    find-volumes [ volume>paths ] map
+    concat [
+        [ file-system-info ]
+        [ drop winnt-file-system-info new swap >>mount-point ] recover
+    ] map ;
+
 : file-times ( path -- timestamp timestamp timestamp )
     [
         normalize-path open-existing &dispose handle>>

basis/unix/statfs/linux/32/32.factor

@@ -19,8 +19,8 @@ C-STRUCT: statfs
 FUNCTION: int statfs ( char* path, statfs* buf ) ;
 
 TUPLE: linux32-file-system-info < file-system-info
-type bsize blocks bfree bavail files ffree fsid
+bsize blocks bfree bavail files ffree fsid namelen
-namelen frsize spare ;
+frsize spare ;
 
 M: linux >file-system-info ( struct -- statfs )
     [ \ linux32-file-system-info new ] dip

basis/unix/statfs/linux/64/64.factor

@@ -21,8 +21,8 @@ C-STRUCT: statfs64
 FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
 
 TUPLE: linux64-file-system-info < file-system-info
-type bsize blocks bfree bavail files ffree fsid
+bsize blocks bfree bavail files ffree fsid namelen
-namelen frsize spare ;
+frsize spare ;
 
 M: linux >file-system-info ( struct -- statfs )
     [ \ linux64-file-system-info new ] dip

basis/unix/statfs/linux/linux.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types combinators kernel io.files unix.stat
+USING: alien.c-types combinators kernel unix.stat
 math accessors system unix io.backend layouts vocabs.loader
 sequences csv io.streams.string io.encodings.utf8 namespaces
 unix.statfs io.files ;
@@ -32,7 +32,7 @@ frequency pass-number ;
     ] with-scope
     [ mtab-csv>mtab-entry ] map ;
 
-M: linux mounted
+M: linux file-systems
     parse-mtab [
         [ mount-point>> file-system-info ] keep
         {

basis/unix/statfs/macosx/macosx.factor

@@ -122,7 +122,7 @@ TUPLE: macosx-file-system-info < file-system-info
 block-size io-size blocks blocks-free blocks-available files
 files-free file-system-id owner type-id flags filesystem-subtype ;
 
-M: macosx mounted ( -- array )
+M: macosx file-systems ( -- array )
     f <void*> dup 0 getmntinfo64 dup io-error
     [ *void* ] dip
     "statfs64" heap-size [ * memory>byte-array ] keep group

basis/unix/statfs/statfs.factor

@@ -4,12 +4,8 @@ USING: sequences system vocabs.loader combinators accessors
 kernel math.order sorting ;
 IN: unix.statfs
 
-TUPLE: file-system-info root-directory total-free-size total-size ;
-
 HOOK: >file-system-info os ( struct -- statfs )
 
-HOOK: mounted os ( -- array )
-
 os {
     { linux   [ "unix.statfs.linux"   require ] }
     { macosx  [ "unix.statfs.macosx"  require ] }

basis/windows/kernel32/kernel32.factor

@@ -954,7 +954,8 @@ ALIAS: GetDiskFreeSpaceEx GetDiskFreeSpaceExW
 ! FUNCTION: GetDllDirectoryA
 ! FUNCTION: GetDllDirectoryW
 ! FUNCTION: GetDriveTypeA
-! FUNCTION: GetDriveTypeW
+FUNCTION: UINT GetDriveTypeW ( LPCTSTR lpRootPathName ) ;
+ALIAS: GetDriveType GetDriveTypeW
 FUNCTION: void* GetEnvironmentStringsW ( ) ;
 ! FUNCTION: GetEnvironmentStringsA
 ALIAS: GetEnvironmentStrings GetEnvironmentStringsW
@@ -999,7 +1000,7 @@ FUNCTION: DWORD GetLastError ( ) ;
 ! FUNCTION: GetLocaleInfoA
 ! FUNCTION: GetLocaleInfoW
 ! FUNCTION: GetLocalTime
-! FUNCTION: GetLogicalDrives
+FUNCTION: DWORD GetLogicalDrives ( ) ;
 ! FUNCTION: GetLogicalDriveStringsA
 ! FUNCTION: GetLogicalDriveStringsW
 ! FUNCTION: GetLongPathNameA
@@ -1129,7 +1130,9 @@ ALIAS: GetVolumeInformation GetVolumeInformationW
 ! FUNCTION: GetVolumeNameForVolumeMountPointW
 ! FUNCTION: GetVolumePathNameA
 ! FUNCTION: GetVolumePathNamesForVolumeNameA
-! FUNCTION: GetVolumePathNamesForVolumeNameW
+FUNCTION: BOOL GetVolumePathNamesForVolumeNameW ( LPCTSTR lpszVolumeName, LPTSTR lpszVolumePathNames, DWORD cchBufferLength, PDWORD lpcchReturnLength ) ;
+ALIAS: GetVolumePathNamesForVolumeName GetVolumePathNamesForVolumeNameW
+
 ! FUNCTION: GetVolumePathNameW
 ! FUNCTION: GetWindowsDirectoryA
 FUNCTION: UINT GetWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ;

core/io/files/files-docs.factor

@@ -1,5 +1,5 @@
-USING: help.markup help.syntax io strings
+USING: help.markup help.syntax io strings arrays io.backend
-       io.backend io.files.private quotations ;
+io.files.private quotations ;
 IN: io.files
 
 ARTICLE: "file-streams" "Reading and writing files"
@@ -323,6 +323,10 @@ HELP: with-directory-files
 { $values { "path" "a pathname string" } { "quot" quotation } }
 { $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ".  Restores the current directory after the quotation is called." } ;
 
+HELP: file-systems
+{ $values { "array" array } }
+{ $description "Returns an array of " { $link file-system-info } " objects returned by iterating the mount points and calling " { $link file-system-info } " on each." } ;
+
 HELP: file-system-info
 { $values
 { "path" "a pathname string" }

core/io/files/files.factor

@@ -184,6 +184,8 @@ SYMBOL: +unknown+
 
 ! File-system
 
+HOOK: file-systems os ( -- array )
+
 TUPLE: file-system-info device-name mount-point type free-space ;
 
 HOOK: file-system-info os ( path -- file-system-info )