basis/io/files/windows/nt/nt.factor

   1 USING: accessors alien.c-types alien.strings classes.struct
   2 combinators combinators.short-circuit continuations environment
   3 io.backend io.backend.windows io.encodings.utf16n
   4 io.files.private io.files.windows io.pathnames kernel math
   5 sequences specialized-arrays system tr
   6 windows windows.errors windows.kernel32 windows.shell32
   7 windows.time ;
   8 SPECIALIZED-ARRAY: ushort
   9 IN: io.files.windows.nt
  10
  11 M: winnt cwd
  12     MAX_UNICODE_PATH dup <ushort-array>
  13     [ GetCurrentDirectory win32-error=0/f ] keep
  14     utf16n alien>string ;
  15
  16 M: winnt cd
  17     SetCurrentDirectory win32-error=0/f ;
  18
  19 CONSTANT: unicode-prefix "\\\\?\\"
  20
  21 M: winnt root-directory? ( path -- ? )
  22     {
  23         { [ dup empty? ] [ drop f ] }
  24         { [ dup [ path-separator? ] all? ] [ drop t ] }
  25         { [ dup trim-tail-separators { [ length 2 = ]
  26           [ second CHAR: : = ] } 1&& ] [ drop t ] }
  27         { [ dup unicode-prefix head? ]
  28           [ trim-tail-separators length unicode-prefix length 2 + = ] }
  29         [ drop f ]
  30     } cond ;
  31
  32 : prepend-prefix ( string -- string' )
  33     dup unicode-prefix head? [
  34         unicode-prefix prepend
  35     ] unless ;
  36
  37 TR: normalize-separators "/" "\\" ;
  38
  39 M: winnt normalize-path ( string -- string' )
  40     absolute-path
  41     normalize-separators
  42     prepend-prefix ;
  43
  44 M: winnt CreateFile-flags ( DWORD -- DWORD )
  45     FILE_FLAG_OVERLAPPED bitor ;
  46
  47 <PRIVATE
  48
  49 : windows-file-size ( path -- size )
  50     normalize-path 0 WIN32_FILE_ATTRIBUTE_DATA <struct>
  51     [ GetFileAttributesEx win32-error=0/f ] keep
  52     [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit ;
  53
  54 PRIVATE>
  55
  56 M: winnt open-append
  57     [ dup windows-file-size ] [ drop 0 ] recover
  58     [ (open-append) ] dip >>ptr ;
  59
  60 M: winnt home
  61     {
  62         [ "HOMEDRIVE" os-env "HOMEPATH" os-env append-path ]
  63         [ "USERPROFILE" os-env ]
  64         [ my-documents ]
  65     } 0|| ;