1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien.c-types io.binary io.backend io.files
4 io.files.types io.buffers io.encodings.utf16n io.ports
5 io.backend.windows kernel math splitting fry alien.strings
6 windows windows.kernel32 windows.time calendar combinators
7 math.functions sequences namespaces make words system
8 destructors accessors math.bitwise continuations windows.errors
9 arrays byte-arrays generalizations alien.data ;
12 : open-file ( path access-mode create-mode flags -- handle )
14 [ share-mode default-security-attributes ] 2dip
15 CreateFile-flags f CreateFile opened-file
18 : open-r/w ( path -- win32-file )
19 { GENERIC_READ GENERIC_WRITE } flags
20 OPEN_EXISTING 0 open-file ;
22 : open-read ( path -- win32-file )
23 GENERIC_READ OPEN_EXISTING 0 open-file 0 >>ptr ;
25 : open-write ( path -- win32-file )
26 GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 >>ptr ;
28 : (open-append) ( path -- win32-file )
29 GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
31 : open-existing ( path -- win32-file )
32 { GENERIC_READ GENERIC_WRITE } flags
36 FILE_FLAG_BACKUP_SEMANTICS
37 f CreateFileW dup win32-error=0/f <win32-file> ;
39 : maybe-create-file ( path -- win32-file ? )
40 #! return true if file was just created
41 { GENERIC_READ GENERIC_WRITE } flags
46 f CreateFileW dup win32-error=0/f <win32-file>
47 GetLastError ERROR_ALREADY_EXISTS = not ;
49 : set-file-pointer ( handle length method -- )
50 [ [ handle>> ] dip d>w/w <uint> ] dip SetFilePointer
51 INVALID_SET_FILE_POINTER = [ "SetFilePointer failed" throw ] when ;
53 HOOK: open-append os ( path -- win32-file )
56 hFile lpBuffer nNumberOfBytesToRead
57 lpNumberOfBytesRet lpOverlapped ;
59 C: <FileArgs> FileArgs
61 : make-FileArgs ( port -- <FileArgs> )
63 [ handle>> check-disposed ]
66 [ buffer>> buffer-length ]
67 [ drop "DWORD" <c-object> ]
68 [ FileArgs-overlapped ]
71 : setup-read ( <FileArgs> -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped )
74 [ lpBuffer>> buffer-end ]
75 [ lpBuffer>> buffer-capacity ]
76 [ lpNumberOfBytesRet>> ]
80 : setup-write ( <FileArgs> -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped )
83 [ lpBuffer>> buffer@ ]
84 [ lpBuffer>> buffer-length ]
85 [ lpNumberOfBytesRet>> ]
89 M: windows (file-reader) ( path -- stream )
90 open-read <input-port> ;
92 M: windows (file-writer) ( path -- stream )
93 open-write <output-port> ;
95 M: windows (file-appender) ( path -- stream )
96 open-append <output-port> ;
98 SYMBOLS: +read-only+ +hidden+ +system+
99 +archive+ +device+ +normal+ +temporary+
100 +sparse-file+ +reparse-point+ +compressed+ +offline+
101 +not-content-indexed+ +encrypted+ ;
103 : win32-file-attribute ( n attr symbol -- )
104 rot mask? [ , ] [ drop ] if ;
106 : win32-file-attributes ( n -- seq )
109 [ +read-only+ FILE_ATTRIBUTE_READONLY win32-file-attribute ]
110 [ +hidden+ FILE_ATTRIBUTE_HIDDEN win32-file-attribute ]
111 [ +system+ FILE_ATTRIBUTE_SYSTEM win32-file-attribute ]
112 [ +directory+ FILE_ATTRIBUTE_DIRECTORY win32-file-attribute ]
113 [ +archive+ FILE_ATTRIBUTE_ARCHIVE win32-file-attribute ]
114 [ +device+ FILE_ATTRIBUTE_DEVICE win32-file-attribute ]
115 [ +normal+ FILE_ATTRIBUTE_NORMAL win32-file-attribute ]
116 [ +temporary+ FILE_ATTRIBUTE_TEMPORARY win32-file-attribute ]
117 [ +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE win32-file-attribute ]
118 [ +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT win32-file-attribute ]
119 [ +compressed+ FILE_ATTRIBUTE_COMPRESSED win32-file-attribute ]
120 [ +offline+ FILE_ATTRIBUTE_OFFLINE win32-file-attribute ]
121 [ +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED win32-file-attribute ]
122 [ +encrypted+ FILE_ATTRIBUTE_ENCRYPTED win32-file-attribute ]
126 : win32-file-type ( n -- symbol )
127 FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ;
129 : (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- )
130 [ timestamp>FILETIME ] tri@
131 SetFileTime win32-error=0/f ;