basis/io/directories/windows/windows.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: system io.directories alien.strings
   4 io.pathnames io.backend io.files.windows destructors
   5 kernel accessors calendar windows windows.errors
   6 windows.kernel32 alien.c-types sequences splitting
   7 fry continuations classes.struct windows.time ;
   8 IN: io.directories.windows
   9
  10 M: windows touch-file
  11     [
  12         normalize-path
  13         maybe-create-file [ &dispose ] dip
  14         [ drop ] [ handle>> f now dup (set-file-times) ] if
  15     ] with-destructors ;
  16
  17 M: windows move-file
  18     [ normalize-path ] bi@ MoveFile win32-error=0/f ;
  19
  20 M: windows move-file-atomically
  21     [ normalize-path ] bi@ 0 MoveFileEx win32-error=0/f ;
  22
  23 ERROR: file-delete-failed path error ;
  24
  25 : delete-file-throws ( path -- )
  26     DeleteFile win32-error=0/f ;
  27
  28 : delete-read-only-file ( path -- )
  29     [ set-file-normal-attribute ] [ delete-file-throws ] bi ;
  30
  31 : (delete-file) ( path -- )
  32     dup DeleteFile 0 = [
  33         GetLastError ERROR_ACCESS_DENIED =
  34         [ delete-read-only-file ] [ drop win32-error ] if
  35     ] [ drop ] if ;
  36
  37 M: windows delete-file
  38     absolute-path
  39     [ (delete-file) ]
  40     [ file-delete-failed boa rethrow ] recover ;
  41
  42 M: windows make-directory
  43     normalize-path
  44     f CreateDirectory win32-error=0/f ;
  45
  46 M: windows delete-directory
  47     normalize-path
  48     RemoveDirectory win32-error=0/f ;
  49
  50 : find-first-file ( path WIN32_FIND_DATA -- WIN32_FIND_DATA HANDLE )
  51     [ nip ] [ FindFirstFile ] 2bi check-invalid-handle ;
  52
  53 : find-next-file ( HANDLE WIN32_FIND_DATA -- WIN32_FIND_DATA/f )
  54     [ nip ] [ FindNextFile ] 2bi 0 = [
  55         GetLastError ERROR_NO_MORE_FILES = [
  56             win32-error
  57         ] unless drop f
  58     ] when ;
  59
  60 TUPLE: windows-directory-entry < directory-entry attributes size ;
  61
  62 C: <windows-directory-entry> windows-directory-entry
  63
  64 : >windows-directory-entry ( WIN32_FIND_DATA -- directory-entry )
  65     [ cFileName>> alien>native-string ]
  66     [
  67         dwFileAttributes>>
  68         [ win32-file-type ] [ win32-file-attributes ] bi
  69         dupd remove
  70     ]
  71     [ [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit ] tri
  72     <windows-directory-entry> ; inline
  73
  74 M: windows (directory-entries)
  75     "\\" ?tail drop "\\*" append
  76     WIN32_FIND_DATA <struct>
  77     find-first-file over
  78     [ >windows-directory-entry ] 2dip
  79     [
  80         '[
  81             [ _ _ find-next-file dup ]
  82             [ >windows-directory-entry ]
  83             produce nip
  84             over name>> "." = [ nip ] [ swap prefix ] if
  85         ]
  86     ] [ drop '[ _ FindClose win32-error=0/f ] ] 2bi finally ;