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

   1 USING: continuations destructors io.buffers io.files io.backend
   2 io.timeouts io.ports io.pathnames io.files.private io.backend.windows
   3 io.files.windows io.backend.windows.nt io.encodings.utf16n
   4 windows windows.kernel32 kernel libc math threads system
   5 environment alien.c-types alien.arrays alien.strings sequences
   6 combinators combinators.short-circuit ascii splitting alien
   7 strings assocs namespaces make accessors tr ;
   8 IN: io.files.windows.nt
   9
  10 M: winnt cwd
  11     MAX_UNICODE_PATH dup "ushort" <c-array>
  12     [ GetCurrentDirectory win32-error=0/f ] keep
  13     utf16n alien>string ;
  14
  15 M: winnt cd
  16     SetCurrentDirectory win32-error=0/f ;
  17
  18 : unicode-prefix ( -- seq )
  19     "\\\\?\\" ; inline
  20
  21 M: winnt root-directory? ( path -- ? )
  22     {
  23         { [ dup empty? ] [ drop f ] }
  24         { [ dup [ path-separator? ] all? ] [ drop t ] }
  25         { [ dup trim-right-separators { [ length 2 = ]
  26           [ second CHAR: : = ] } 1&& ] [ drop t ] }
  27         { [ dup unicode-prefix head? ]
  28           [ trim-right-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     (normalize-path)
  41     normalize-separators
  42     prepend-prefix ;
  43
  44 M: winnt CreateFile-flags ( DWORD -- DWORD )
  45     FILE_FLAG_OVERLAPPED bitor ;
  46
  47 M: winnt FileArgs-overlapped ( port -- overlapped )
  48     make-overlapped ;
  49
  50 M: winnt open-append
  51     0 ! [ dup file-info size>> ] [ drop 0 ] recover
  52     [ (open-append) ] dip >>ptr ;
  53
  54 M: winnt home "USERPROFILE" os-env ;