diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 655b5f9daf..7d88392fdc 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -3,7 +3,8 @@ USING: alien.c-types io.backend io.files io.windows kernel math windows windows.kernel32 combinators.cleave windows.time calendar combinators math.functions -sequences namespaces words symbols ; +sequences namespaces words symbols combinators.lib +io.nonblocking destructors ; IN: io.windows.files 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 ) file-info ; + +: file-times ( path -- timestamp timestamp timestamp ) + [ + normalize-pathname open-existing dup close-always + "FILETIME" + "FILETIME" + "FILETIME" + [ 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 ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 635a992777..64c4684e15 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -58,7 +58,8 @@ M: win32-file close-handle ( handle -- ) ] with-destructors ; : 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 ) GENERIC_READ OPEN_EXISTING 0 open-file 0 ; @@ -69,6 +70,24 @@ M: win32-file close-handle ( handle -- ) : (open-append) ( path -- handle ) 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 -- ) dupd d>w/w FILE_BEGIN SetFilePointer INVALID_SET_FILE_POINTER = [