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 io.encodings.utf16n 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 ;
   8 IN: io.directories.windows
   9
  10 M: windows touch-file ( path -- )
  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 ( from to -- )
  18     [ normalize-path ] bi@ MoveFile win32-error=0/f ;
  19
  20 M: windows delete-file ( path -- )
  21     normalize-path DeleteFile win32-error=0/f ;
  22
  23 M: windows copy-file ( from to -- )
  24     dup parent-directory make-directories
  25     [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ;
  26
  27 M: windows make-directory ( path -- )
  28     normalize-path
  29     f CreateDirectory win32-error=0/f ;
  30
  31 M: windows delete-directory ( path -- )
  32     normalize-path
  33     RemoveDirectory win32-error=0/f ;
  34
  35 : find-first-file ( path -- WIN32_FIND_DATA handle )
  36     "WIN32_FIND_DATA" <c-object>
  37     [ nip ] [ FindFirstFile ] 2bi
  38     [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
  39
  40 : find-next-file ( path -- WIN32_FIND_DATA/f )
  41     "WIN32_FIND_DATA" <c-object>
  42     [ nip ] [ FindNextFile ] 2bi 0 = [
  43         GetLastError ERROR_NO_MORE_FILES = [
  44             win32-error
  45         ] unless drop f
  46     ] when ;
  47
  48 TUPLE: windows-directory-entry < directory-entry attributes ;
  49
  50 M: windows >directory-entry ( byte-array -- directory-entry )
  51     [ WIN32_FIND_DATA-cFileName utf16n alien>string ]
  52     [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
  53     [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ]
  54     tri
  55     dupd remove windows-directory-entry boa ;
  56
  57 M: windows (directory-entries) ( path -- seq )
  58     "\\" ?tail drop "\\*" append
  59     find-first-file [ >directory-entry ] dip
  60     [
  61         '[
  62             [ _ find-next-file dup ]
  63             [ >directory-entry ]
  64             [ drop ] produce
  65             over name>> "." = [ nip ] [ swap prefix ] if
  66         ]
  67     ] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ;
  68