]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/io/files/info/windows/windows.factor
io.files.info.windows: Fix file-systems word in two ways. First, don't
[factor.git] / basis / io / files / info / windows / windows.factor
index 417a2353c2331f2dd5ac6226874a4d7b3e768a4c..3b349403d0fe9132c06ba453f365435e6515aff4 100755 (executable)
@@ -4,11 +4,12 @@ USING: byte-arrays math io.backend io.files.info
 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' )
@@ -101,7 +102,7 @@ CONSTANT: path-length $[ MAX_PATH 1 + ]
     { { 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 }
@@ -146,16 +147,10 @@ M: windows file-system-info ( path -- file-system-info )
 
 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 } }
@@ -163,7 +158,7 @@ CONSTANT: names-buf-length 16384
     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
@@ -174,11 +169,22 @@ CONSTANT: names-buf-length 16384
         ]
     ] [ '[ _ 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 )