io.files.windows kernel windows.kernel32
windows.time windows.types windows accessors alien.c-types
combinators generalizations system alien.strings
-io.encodings.utf16n sequences splitting windows.errors fry
+sequences splitting windows.errors fry
continuations destructors calendar ascii
combinators.short-circuit literals locals classes.struct
-specialized-arrays alien.data ;
+specialized-arrays alien.data libc ;
SPECIALIZED-ARRAY: ushort
+QUALIFIED: sequences
IN: io.files.info.windows
:: round-up-to ( n multiple -- n' )
{ { ushort path-length } DWORD DWORD DWORD { ushort path-length } }
[ [ path-length ] 4dip path-length GetVolumeInformation win32-error=0/f ]
with-out-parameters
- [ utf16n alien>string ] 4dip utf16n alien>string ;
+ [ alien>native-string ] 4dip alien>native-string ;
: file-system-space ( normalized-path -- available-space total-space free-space )
{ ULARGE_INTEGER ULARGE_INTEGER ULARGE_INTEGER }
CONSTANT: names-buf-length 16384
-: volume>paths ( string -- array )
- { { ushort names-buf-length } uint }
- [ [ names-buf-length ] dip GetVolumePathNamesForVolumeName win32-error=0/f ]
- with-out-parameters
- head utf16n alien>string { CHAR: \0 } split ;
-
: find-first-volume ( -- string handle )
{ { ushort path-length } }
[ path-length FindFirstVolume dup win32-error=0/f ]
- with-out-parameters utf16n alien>string swap ;
+ with-out-parameters alien>native-string swap ;
: find-next-volume ( handle -- string/f )
{ { ushort path-length } }
swap 0 = [
GetLastError ERROR_NO_MORE_FILES =
[ drop f ] [ win32-error-string throw ] if
- ] [ utf16n alien>string ] if ;
+ ] [ alien>native-string ] if ;
: find-volumes ( -- array )
find-first-volume
]
] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ;
+! Windows may return a volume which looks up to path ""
+! For now, treat it like there is not a volume here
+: volume>paths ( string -- array )
+ [
+ names-buf-length
+ [ ushort malloc-array &free ] keep
+ 0 uint <ref>
+ [ GetVolumePathNamesForVolumeName win32-error=0/f ] 3keep nip
+ uint deref head but-last-slice
+ { 0 } split*
+ [ { } ] [ [ alien>native-string ] map ] if-empty
+ ] with-destructors ;
+
M: windows file-systems ( -- array )
- find-volumes [ volume>paths ] map
- concat [
- [ (file-system-info) ]
- [ drop \ file-system-info new swap >>mount-point ] recover
+ find-volumes [ volume>paths ] map concat [
+ (file-system-info)
] map ;
: file-times ( path -- timestamp timestamp timestamp )