]> gitweb.factorcode.org Git - factor.git/commitdiff
add more fields to io.windows.files
authorDoug Coleman <doug.coleman@gmail.com>
Tue, 9 Dec 2008 23:44:37 +0000 (17:44 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Tue, 9 Dec 2008 23:44:37 +0000 (17:44 -0600)
basis/io/windows/files/files.factor

index 894ddc83c6b666844f1e5d3b7b652ab88e9725c9..59b77e3b78e9543e3207160327020ec95bf27337 100755 (executable)
@@ -5,7 +5,7 @@ io.encodings.utf16n io.ports io.windows kernel math splitting
 fry alien.strings windows windows.kernel32 windows.time calendar
 combinators math.functions sequences namespaces make words
 symbols system destructors accessors math.bitwise continuations
-windows.errors arrays byte-arrays ;
+windows.errors arrays byte-arrays generalizations ;
 IN: io.windows.files
 
 : open-file ( path access-mode create-mode flags -- handle )
@@ -117,7 +117,7 @@ M: windows delete-directory ( path -- )
 : find-first-file ( path -- WIN32_FIND_DATA handle )
     "WIN32_FIND_DATA" <c-object> tuck
     FindFirstFile
-    [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep ;
+    [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
 
 : find-next-file ( path -- WIN32_FIND_DATA/f )
     "WIN32_FIND_DATA" <c-object> tuck
@@ -257,13 +257,15 @@ M: winnt link-info ( path -- info )
 
 HOOK: root-directory os ( string -- string' )
 
-: file-system-type ( normalized-path -- str )
-    MAX_PATH 1+ <byte-array>
-    MAX_PATH 1+
-    "DWORD" <c-object> "DWORD" <c-object> "DWORD" <c-object>
-    MAX_PATH 1+ <byte-array>
-    MAX_PATH 1+
-    [ GetVolumeInformation win32-error=0/f ] 2keep drop
+: volume-information ( normalized-path -- volume-name volume-serial max-component flags type )
+    MAX_PATH 1+ [ <byte-array> ] keep
+    "DWORD" <c-object>
+    "DWORD" <c-object>
+    "DWORD" <c-object>
+    MAX_PATH 1+ [ <byte-array> ] keep
+    [ GetVolumeInformation win32-error=0/f ] 7 nkeep
+    drop 5 nrot drop
+    [ utf16n alien>string ] 4 ndip
     utf16n alien>string ;
 
 : file-system-space ( normalized-path -- available-space total-space free-space )
@@ -278,14 +280,21 @@ HOOK: root-directory os ( string -- string' )
         [ ]
     } cleave ;
 
+TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ;
+
 M: winnt file-system-info ( path -- file-system-info )
     normalize-path root-directory
-    dup [ file-system-type ] [ file-system-space ] bi
-    \ file-system-info new
+    ! volume-information ( normalized-path -- volume-name volume-serial max-component flags type )
+    dup [ volume-information ] [ file-system-space ] bi
+    \ win32-file-system-info new
         swap *ulonglong >>free-space
         swap *ulonglong >>total-space
         swap *ulonglong >>available-space
         swap >>type
+        swap *uint >>flags
+        swap *uint >>max-component
+        swap *uint >>device-serial
+        swap >>device-name
         swap >>mount-point
     calculate-file-system-info ;
 
@@ -299,16 +308,16 @@ M: winnt file-system-info ( path -- file-system-info )
     ] if ;
 
 : find-first-volume ( -- string handle )
-    MAX_PATH 1+ <byte-array> dup length
+    MAX_PATH 1+ [ <byte-array> ] keep
     dupd
     FindFirstVolume dup win32-error=0/f
     [ utf16n alien>string ] dip ;
 
 : find-next-volume ( handle -- string/f )
-    MAX_PATH 1+ <byte-array> dup length
-    over [ FindNextVolume ] dip swap 0 = [
+    MAX_PATH 1+ [ <byte-array> tuck ] keep
+    FindNextVolume 0 = [
         GetLastError ERROR_NO_MORE_FILES =
-        [ drop f ] [ win32-error ] if
+        [ drop f ] [ win32-error-string throw ] if
     ] [
         utf16n alien>string
     ] if ;