unmaintained/io/os-winnt.factor

   1 USING: alien calendar errors generic io io-internals kernel
   2 math namespaces nonblocking-io parser quotations sequences
   3 shuffle windows-api words ;
   4 IN: libs-io
   5
   6 : stat* ( path -- WIN32_FIND_DATA )
   7     "WIN32_FIND_DATA" <c-object>
   8     [
   9         FindFirstFile
  10         [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
  11         FindClose win32-error=0/f
  12     ] keep ;
  13
  14 : set-file-time ( path timestamp/f timestamp/f timestamp/f -- )
  15     #! timestamp order: creation access write
  16     >r >r >r open-existing dup r> r> r>
  17     [ timestamp>FILETIME ] 3 napply
  18     SetFileTime win32-error=0/f
  19     close-handle ;
  20
  21 : set-file-times ( path timestamp/f timestamp/f -- )
  22     f -rot set-file-time ;
  23
  24 : set-file-create-time ( path timestamp -- )
  25     f f set-file-time ;
  26
  27 : set-file-access-time ( path timestamp -- )
  28     >r f r> f set-file-time ;
  29
  30 : set-file-write-time ( path timestamp -- )
  31     >r f f r> set-file-time ;
  32
  33 : maybe-make-filetime ( ? -- FILETIME/f )
  34     [ "FILETIME" <c-object> ] [ f ] if ;
  35
  36 : file-time ( path ? ? ? -- FILETIME/f FILETIME/f FILETIME/f )
  37     >r >r >r open-existing dup r> r> r>
  38     [ maybe-make-filetime ] 3 napply
  39     [ GetFileTime win32-error=0/f close-handle ] 3keep ;
  40
  41 : file-times ( path -- FILETIME FILETIME FILETIME )
  42     t t t file-time [ FILETIME>timestamp ] 3 napply ;
  43
  44 : file-create-time ( path -- FILETIME )
  45     t f f file-time 2drop FILETIME>timestamp ;
  46
  47 : file-access-time ( path -- FILETIME )
  48     f t f file-time drop nip FILETIME>timestamp ;
  49
  50 : file-write-time ( path -- FILETIME )
  51     f f t file-time 2nip FILETIME>timestamp ;
  52
  53 : attrib ( path -- n )
  54     [ stat* WIN32_FIND_DATA-dwFileAttributes ] catch
  55     [ drop 0 ] when ;
  56
  57 : (read-only?) ( mode -- ? )
  58     FILE_ATTRIBUTE_READONLY bit-set? ;
  59
  60 : read-only? ( path -- ? )
  61     attrib (read-only?) ;
  62
  63 : (hidden?) ( mode -- ? )
  64     FILE_ATTRIBUTE_HIDDEN bit-set? ;
  65
  66 : hidden? ( path -- ? )
  67     attrib (hidden?) ;
  68
  69 : (system?) ( mode -- ? )
  70     FILE_ATTRIBUTE_SYSTEM bit-set? ;
  71
  72 : system? ( path -- ? )
  73     attrib (system?) ;
  74
  75 : (directory?) ( mode -- ? )
  76     FILE_ATTRIBUTE_DIRECTORY bit-set? ;
  77
  78 : directory? ( path -- ? )
  79     attrib (directory?) ;
  80
  81 : (archive?) ( mode -- ? )
  82     FILE_ATTRIBUTE_ARCHIVE bit-set? ;
  83
  84 : archive? ( path -- ? )
  85     attrib (archive?) ;
  86
  87 ! FILE_ATTRIBUTE_DEVICE
  88 ! FILE_ATTRIBUTE_NORMAL
  89 ! FILE_ATTRIBUTE_TEMPORARY
  90 ! FILE_ATTRIBUTE_SPARSE_FILE
  91 ! FILE_ATTRIBUTE_REPARSE_POINT
  92 ! FILE_ATTRIBUTE_COMPRESSED
  93 ! FILE_ATTRIBUTE_OFFLINE
  94 ! FILE_ATTRIBUTE_NOT_CONTENT_INDEXED
  95 ! FILE_ATTRIBUTE_ENCRYPTED
  96