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