Merge branch 'master' of git://factorcode.org/git/factor
commit
6ced106bee
|
@ -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
|
||||
utf16n alien>string ;
|
||||
over [ FindNextVolume ] dip swap 0 = [
|
||||
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>>
|
||||
|
|
|
@ -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
|
||||
{
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ] }
|
||||
|
|
|
@ -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 ) ;
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.markup help.syntax io strings
|
||||
io.backend io.files.private quotations ;
|
||||
USING: help.markup help.syntax io strings arrays io.backend
|
||||
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" }
|
||||
|
|
|
@ -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 )
|
||||
|
|
Loading…
Reference in New Issue