From 56081783896fa835a2ddb82dc47d295c18e76bc0 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 19 Oct 2011 02:31:48 -0700
Subject: [PATCH] When deleting a file, if it fails with "Access is denied"
 then set the file attributes to normal and try again. Some files in the .git
 directory are set to read-only, preventing the build machines from deleting
 old builds.

---
 basis/io/directories/windows/windows.factor | 15 ++++++++++++++-
 basis/io/files/windows/windows.factor       |  9 +++++++++
 basis/windows/kernel32/kernel32.factor      |  3 ++-
 3 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor
index b889f435e4..3d1bfddde5 100644
--- a/basis/io/directories/windows/windows.factor
+++ b/basis/io/directories/windows/windows.factor
@@ -19,8 +19,21 @@ M: windows move-file ( from to -- )
 
 ERROR: file-delete-failed path error ;
 
+: delete-file-throws ( path -- )
+    DeleteFile win32-error=0/f ;
+
+: delete-read-only-file ( path -- )
+    [ set-file-normal-attribute ] [ delete-file-throws ] bi ;
+
+: (delete-file) ( path -- )
+    dup DeleteFile 0 = [
+        GetLastError ERROR_ACCESS_DENIED =
+        [ delete-read-only-file ] [ win32-error ] if
+    ] [ drop ] if ;
+
 M: windows delete-file ( path -- )
-    [ normalize-path DeleteFile win32-error=0/f ]
+    normalize-path
+    [ (delete-file) ]
     [ \ file-delete-failed boa rethrow ] recover ;
 
 M: windows copy-file ( from to -- )
diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor
index f25a19df9b..0b8c116c0f 100755
--- a/basis/io/files/windows/windows.factor
+++ b/basis/io/files/windows/windows.factor
@@ -281,6 +281,15 @@ SYMBOLS: +read-only+ +hidden+ +system+
 +sparse-file+ +reparse-point+ +compressed+ +offline+
 +not-content-indexed+ +encrypted+ ;
 
+: read-only? ( file-info -- ? )
+    attributes>> +read-only+ swap member? ;
+    
+: set-file-attributes ( path flags -- )
+    SetFileAttributes win32-error=0/f ;
+    
+: set-file-normal-attribute ( path -- )
+    FILE_ATTRIBUTE_NORMAL set-file-attributes ;
+
 : win32-file-attribute ( n symbol attr -- )
     rot mask? [ , ] [ drop ] if ;
 
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index be11fc66a0..0ab4e5ef97 100644
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -1770,7 +1770,8 @@ ALIAS: SetEnvironmentVariable SetEnvironmentVariableW
 ! FUNCTION: SetFileApisToANSI
 ! FUNCTION: SetFileApisToOEM
 ! FUNCTION: SetFileAttributesA
-! FUNCTION: SetFileAttributesW
+FUNCTION: BOOL SetFileAttributesW ( LPCTSTR lpFileName, DWORD dwFileAttributes ) ;
+ALIAS: SetFileAttributes SetFileAttributesW
 FUNCTION: DWORD SetFilePointer ( HANDLE hFile, LONG lDistanceToMove, PLONG lpDistanceToMoveHigh, DWORD dwMoveMethod ) ;
 FUNCTION: DWORD SetFilePointerEx ( HANDLE hFile, LARGE_INTEGER lDistanceToMove, PLARGE_INTEGER lpDistanceToMoveHigh, DWORD dwMoveMethod ) ;
 ! FUNCTION: SetFileShortNameA
-- 
2.34.1