implement file-systems on windows

db4
Doug Coleman 2008-11-11 15:17:35 -06:00
parent 17916ed7f2
commit 146340690f
2 changed files with 25 additions and 8 deletions

View File

@ -276,18 +276,31 @@ M: winnt file-system-info ( path -- file-system-info )
swap >>type swap >>type
swap >>mount-point ; 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 ) : find-first-volume ( -- string handle )
MAX_PATH 1+ <byte-array> dup length MAX_PATH 1+ <byte-array> dup length
dupd dupd
FindFirstVolume dup win32-error=0/f FindFirstVolume dup win32-error=0/f
[ utf16n alien>string ] dip ; [ utf16n alien>string ] dip ;
: find-next-volume ( handle -- string ) : find-next-volume ( handle -- string/f )
MAX_PATH 1+ <byte-array> dup length 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 ) M: winnt file-systems ( -- array )
find-first-volume find-first-volume
[ [
'[ '[
@ -296,7 +309,8 @@ M: winnt file-system-info ( path -- file-system-info )
[ drop ] produce [ drop ] produce
swap prefix swap prefix
] ]
] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup
[ volume>paths ] map ;
: file-times ( path -- timestamp timestamp timestamp ) : file-times ( path -- timestamp timestamp timestamp )
[ [

View File

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