steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

implement touch-file on windows

db4
Doug Coleman 2008-03-28 13:37:05 -05:00
parent bbd1ac7180
commit 3e2a867c3a
2 changed files with 60 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
extra/io/windows/files/files.factor
View File

@ -3,7 +3,8 @@
USING: alien.c-types io.backend io.files io.windows kernel USING: alien.c-types io.backend io.files io.windows kernel
math windows windows.kernel32 combinators.cleave math windows windows.kernel32 combinators.cleave
windows.time calendar combinators math.functions windows.time calendar combinators math.functions
sequences namespaces words symbols ; sequences namespaces words symbols combinators.lib
io.nonblocking destructors ;
IN: io.windows.files IN: io.windows.files
SYMBOLS: +read-only+ +hidden+ +system+ SYMBOLS: +read-only+ +hidden+ +system+
@ -93,3 +94,41 @@ M: windows-nt-io file-info ( path -- info )
M: windows-nt-io link-info ( path -- info ) M: windows-nt-io link-info ( path -- info )
file-info ; file-info ;
: file-times ( path -- timestamp timestamp timestamp )
[
normalize-pathname open-existing dup close-always
"FILETIME" <c-object>
"FILETIME" <c-object>
"FILETIME" <c-object>
[ GetFileTime win32-error=0/f ] 3keep
[ FILETIME>timestamp >local-time ] 3apply
] with-destructors ;
: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- )
[ timestamp>FILETIME ] 3apply
SetFileTime win32-error=0/f ;
: set-file-times ( path timestamp/f timestamp/f timestamp/f -- )
#! timestamp order: creation access write
[
>r >r >r
normalize-pathname open-existing dup close-always
r> r> r> (set-file-times)
] with-destructors ;
: set-file-create-time ( path timestamp -- )
f f set-file-times ;
: set-file-access-time ( path timestamp -- )
>r f r> f set-file-times ;
: set-file-write-time ( path timestamp -- )
>r f f r> set-file-times ;
M: windows-nt-io touch-file ( path -- )
[
normalize-pathname
maybe-create-file over close-always
[ drop ] [ f now dup (set-file-times) ] if
] with-destructors ;

21
extra/io/windows/windows.factor
View File

@ -58,7 +58,8 @@ M: win32-file close-handle ( handle -- )
] with-destructors ; ] with-destructors ;
: open-pipe-r/w ( path -- handle ) : open-pipe-r/w ( path -- handle )
GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING 0 open-file ; { GENERIC_READ GENERIC_WRITE } flags
OPEN_EXISTING 0 open-file ;
: open-read ( path -- handle length ) : open-read ( path -- handle length )
GENERIC_READ OPEN_EXISTING 0 open-file 0 ; GENERIC_READ OPEN_EXISTING 0 open-file 0 ;
@ -69,6 +70,24 @@ M: win32-file close-handle ( handle -- )
: (open-append) ( path -- handle ) : (open-append) ( path -- handle )
GENERIC_WRITE OPEN_ALWAYS 0 open-file ; GENERIC_WRITE OPEN_ALWAYS 0 open-file ;
: open-existing ( path -- handle )
{ GENERIC_READ GENERIC_WRITE } flags
share-mode
f
OPEN_EXISTING
FILE_FLAG_BACKUP_SEMANTICS
f CreateFileW dup win32-error=0/f ;
: maybe-create-file ( path -- handle ? )
#! return true if file was just created
{ GENERIC_READ GENERIC_WRITE } flags
share-mode
f
OPEN_ALWAYS
0 CreateFile-flags
f CreateFileW dup win32-error=0/f
GetLastError ERROR_ALREADY_EXISTS = not ;
: set-file-pointer ( handle length -- ) : set-file-pointer ( handle length -- )
dupd d>w/w <uint> FILE_BEGIN SetFilePointer dupd d>w/w <uint> FILE_BEGIN SetFilePointer
INVALID_SET_FILE_POINTER = [ INVALID_SET_FILE_POINTER = [