From 6282a4ec5d42c2ec4a1279b47309182352dce5ec Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 4 Mar 2008 22:35:45 -0600
Subject: [PATCH] add windows replacement for stat
---
extra/io/windows/files/files.factor | 108 ++++++++++++++++++++++++++++
1 file changed, 108 insertions(+)
create mode 100644 extra/io/windows/files/files.factor
diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor
new file mode 100644
index 0000000000..fdd574d00e
--- /dev/null
+++ b/extra/io/windows/files/files.factor
@@ -0,0 +1,108 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types io.files io.windows kernel
+math windows windows.kernel32 combinators.cleave
+windows.time calendar combinators math.functions
+sequences combinators.lib namespaces words ;
+IN: io.windows.files
+
+SYMBOL: +read-only+
+SYMBOL: +hidden+
+SYMBOL: +system+
+SYMBOL: +directory+
+SYMBOL: +archive+
+SYMBOL: +device+
+SYMBOL: +normal+
+SYMBOL: +temporary+
+SYMBOL: +sparse-file+
+SYMBOL: +reparse-point+
+SYMBOL: +compressed+
+SYMBOL: +offline+
+SYMBOL: +not-content-indexed+
+SYMBOL: +encrypted+
+
+: expand-constants ( word/obj -- obj'/obj )
+ dup word? [ execute ] when ;
+
+: get-flags ( n seq -- seq' )
+ [
+ [
+ first2 expand-constants
+ [ swapd mask? [ , ] [ drop ] if ] 2curry
+ ] map call-with
+ ] { } make ;
+
+: win32-file-attributes ( n -- seq )
+ {
+ { +read-only+ FILE_ATTRIBUTE_READONLY }
+ { +hidden+ FILE_ATTRIBUTE_HIDDEN }
+ { +system+ FILE_ATTRIBUTE_SYSTEM }
+ { +directory+ FILE_ATTRIBUTE_DIRECTORY }
+ { +archive+ FILE_ATTRIBUTE_ARCHIVE }
+ { +device+ FILE_ATTRIBUTE_DEVICE }
+ { +normal+ FILE_ATTRIBUTE_NORMAL }
+ { +temporary+ FILE_ATTRIBUTE_TEMPORARY }
+ { +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE }
+ { +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT }
+ { +compressed+ FILE_ATTRIBUTE_COMPRESSED }
+ { +offline+ FILE_ATTRIBUTE_OFFLINE }
+ { +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED }
+ { +encrypted+ FILE_ATTRIBUTE_ENCRYPTED }
+ } get-flags ;
+
+: WIN32_FIND_DATA>file-info
+ {
+ [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ]
+ [
+ [ WIN32_FIND_DATA-nFileSizeLow ]
+ [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit
+ ]
+ [ WIN32_FIND_DATA-dwFileAttributes ]
+ [
+ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp
+ ]
+ } cleave
+ \ file-info construct-boa ;
+
+: find-first-file-stat ( path -- WIN32_FIND_DATA )
+ "WIN32_FIND_DATA" <c-object> [
+ FindFirstFile
+ [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
+ FindClose win32-error=0/f
+ ] keep ;
+
+: BY_HANDLE_FILE_INFORMATION>file-info
+ {
+ [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes ]
+ [
+ [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ]
+ [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit
+ ]
+ [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes ]
+ [
+ BY_HANDLE_FILE_INFORMATION-ftLastWriteTime
+ FILETIME>timestamp
+ ]
+ } cleave
+ \ file-info construct-boa ;
+
+: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION )
+ [
+ "BY_HANDLE_FILE_INFORMATION" <c-object>
+ [ GetFileInformationByHandle win32-error=0/f ] keep
+ ] keep CloseHandle win32-error=0/f ;
+
+: get-file-information-stat ( path -- BY_HANDLE_FILE_INFORMATION )
+ dup
+ GENERIC_READ FILE_SHARE_READ f
+ OPEN_EXISTING FILE_FLAG_BACKUP_SEMANTICS f
+ CreateFileW dup INVALID_HANDLE_VALUE = [
+ drop find-first-file-stat WIN32_FIND_DATA>file-info
+ ] [
+ nip
+ get-file-information BY_HANDLE_FILE_INFORMATION>file-info
+ ] if ;
+
+M: windows-nt-io file-info ( path -- info )
+ get-file-information-stat ;
+