io.files overhaul

core/io/files/files-docs.factor

@@ -3,14 +3,32 @@ io.backend io.files.private ;
 IN: io.files
 
 ARTICLE: "file-streams" "Reading and writing files"
+"File streams:"
 { $subsection <file-reader> }
 { $subsection <file-writer> }
 { $subsection <file-appender> }
+"Utility combinators:"
+{ $subsection with-file-reader }
+{ $subsection with-file-writer }
+{ $subsection with-file-appender } ;
+
+ARTICLE: "pathnames" "Pathname manipulation"
 "Pathname manipulation:"
 { $subsection parent-directory }
 { $subsection file-name }
 { $subsection last-path-separator }
 { $subsection path+ }
+"Pathnames relative to Factor's install directory:"
+{ $subsection resource-path }
+{ $subsection ?resource-path }
+"Pathnames relative to Factor's temporary files directory:"
+{ $subsection temp-directory }
+{ $subsection temp-file }
+"Pathname presentations:"
+{ $subsection pathname }
+{ $subsection <pathname> } ;
+
+ARTICLE: "file-system" "The file system"
 "File system meta-data:"
 { $subsection exists? }
 { $subsection directory? }
@@ -19,24 +37,43 @@ ARTICLE: "file-streams" "Reading and writing files"
 { $subsection stat }
 "Directory listing:"
 { $subsection directory }
-"File management:"
+{ $subsection directory* }
-{ $subsection delete-file }
+"Creating directories:"
 { $subsection make-directory }
+{ $subsection make-directories }
+"Deleting files:"
+{ $subsection delete-file }
 { $subsection delete-directory }
+{ $subsection delete-tree }
+"Moving files:"
+{ $subsection move-file }
+{ $subsection move-file-to }
+"Copying files:"
+{ $subsection copy-file }
+{ $subsection copy-file-to }
+{ $subsection copy-tree }
 "Current and home directories:"
-{ $subsection home }
 { $subsection cwd }
 { $subsection cd }
-"Pathnames relative to the Factor install directory:"
+{ $subsection with-directory }
-{ $subsection resource-path }
+{ $subsection home }
-{ $subsection ?resource-path }
-"Pathname presentations:"
-{ $subsection pathname }
-{ $subsection <pathname> }
 { $see-also "os" } ;
 
+ARTICLE: "io.files" "Basic file operations"
+"The " { $vocab-link "io.files" } " vocabulary provides basic support for working with files."
+{ $subsection "file-streams" }
+{ $subsection "pathnames" }
+{ $subsection "file-system" } ;
 ABOUT: "file-streams"
 
+HELP: path-separator?
+{ $values { "ch" "a code point" } { "?" "a boolean" } }
+{ $description "Tests if the code point is a platform-specific path separator." }
+{ $examples
+    "On Unix:"
+    { $example "USING: io.files prettyprint ;" "CHAR: / path-separator? ." "t" }
+} ;
+
 HELP: <file-reader>
 { $values { "path" "a pathname string" } { "stream" "an input stream" } }
 { $description "Outputs an input stream for reading from the specified pathname." }

core/io/files/files-tests.factor

@@ -6,63 +6,118 @@ USING: tools.test io.files io threads kernel continuations ;
 [ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
 
 [ ] [
-    "test-foo.txt" resource-path [
+    "test-foo.txt" temp-file [
         "Hello world." print
     ] with-file-writer
 ] unit-test
 
 [ ] [
-    "test-foo.txt" resource-path <file-appender> [
+    "test-foo.txt" temp-file <file-appender> [
         "Hello appender." print
     ] with-stream
 ] unit-test
 
 [ ] [
-    "test-bar.txt" resource-path <file-appender> [
+    "test-bar.txt" temp-file <file-appender> [
         "Hello appender." print
     ] with-stream
 ] unit-test
 
 [ "Hello world.\nHello appender.\n" ] [
-    "test-foo.txt" resource-path file-contents
+    "test-foo.txt" temp-file file-contents
 ] unit-test
 
 [ "Hello appender.\n" ] [
-    "test-bar.txt" resource-path file-contents
+    "test-bar.txt" temp-file file-contents
 ] unit-test
 
-[ ] [ "test-foo.txt" resource-path delete-file ] unit-test
+[ ] [ "test-foo.txt" temp-file delete-file ] unit-test
 
-[ ] [ "test-bar.txt" resource-path delete-file ] unit-test
+[ ] [ "test-bar.txt" temp-file delete-file ] unit-test
 
-[ f ] [ "test-foo.txt" resource-path exists? ] unit-test
+[ f ] [ "test-foo.txt" temp-file exists? ] unit-test
 
-[ f ] [ "test-bar.txt" resource-path exists? ] unit-test
+[ f ] [ "test-bar.txt" temp-file exists? ] unit-test
 
-[ ] [ "test-blah" resource-path make-directory ] unit-test
+[ ] [ "test-blah" temp-file make-directory ] unit-test
 
 [ ] [
-    "test-blah/fooz" resource-path <file-writer> dispose
+    "test-blah/fooz" temp-file <file-writer> dispose
 ] unit-test
 
 [ t ] [
-    "test-blah/fooz" resource-path exists?
+    "test-blah/fooz" temp-file exists?
 ] unit-test
 
-[ ] [ "test-blah/fooz" resource-path delete-file ] unit-test
+[ ] [ "test-blah/fooz" temp-file delete-file ] unit-test
 
-[ ] [ "test-blah" resource-path delete-directory ] unit-test
+[ ] [ "test-blah" temp-file delete-directory ] unit-test
 
-[ f ] [ "test-blah" resource-path exists? ] unit-test
+[ f ] [ "test-blah" temp-file exists? ] unit-test
 
-[ ] [ "test-quux.txt" resource-path [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
+[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 
-[ ] [ "test-quux.txt" resource-path delete-file ] unit-test
+[ ] [ "test-quux.txt" temp-file delete-file ] unit-test
 
-[ ] [ "test-quux.txt" resource-path [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
+[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 
-[ ] [ "test-quux.txt" "quux-test.txt" [ resource-path ] 2apply rename-file ] unit-test
+[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] 2apply move-file ] unit-test
-[ t ] [ "quux-test.txt" resource-path exists? ] unit-test
+[ t ] [ "quux-test.txt" temp-file exists? ] unit-test
 
-[ ] [ "quux-test.txt" resource-path delete-file ] unit-test
+[ ] [ "quux-test.txt" temp-file delete-file ] unit-test
 
+[ ] [ "delete-tree-test/a/b/c" temp-file make-directories ] unit-test
+
+[ ] [
+    "delete-tree-test/a/b/c/d" temp-file
+    [ "Hi" print ] with-file-writer
+] unit-test
+
+[ ] [
+    "delete-tree-test" temp-file delete-tree
+] unit-test
+
+[ ] [
+    "copy-tree-test/a/b/c" temp-file make-directories
+] unit-test
+
+[ ] [
+    "copy-tree-test/a/b/c/d" temp-file
+    [ "Foobar" write ] with-file-writer
+] unit-test
+
+[ ] [
+    "copy-tree-test" temp-file
+    "copy-destination" temp-file copy-tree
+] unit-test
+
+[ "Foobar" ] [
+    "copy-destination/a/b/c/d" temp-file file-contents
+] unit-test
+
+[ ] [
+    "copy-destination" temp-file delete-tree
+] unit-test
+
+[ ] [
+    "copy-tree-test" temp-file
+    "copy-destination" temp-file copy-tree-to
+] unit-test
+
+[ "Foobar" ] [
+    "copy-destination/copy-tree-test/a/b/c/d" temp-file file-contents
+] unit-test
+
+[ ] [
+    "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-to
+] unit-test
+
+[ "Foobar" ] [
+    "d" temp-file file-contents
+] unit-test
+
+[ ] [ "d" temp-file delete-file ] unit-test
+
+[ ] [ "copy-destination" temp-file delete-tree ] unit-test
+
+[ ] [ "copy-tree-test" temp-file delete-tree ] unit-test

core/io/files/files.factor

@@ -5,30 +5,9 @@ USING: io.backend io.files.private io hashtables kernel math
 memory namespaces sequences strings assocs arrays definitions
 system combinators splitting sbufs continuations ;
 
-HOOK: cd io-backend ( path -- )
+! Pathnames
-
-HOOK: cwd io-backend ( -- path )
-
-HOOK: <file-reader> io-backend ( path -- stream )
-
-HOOK: <file-writer> io-backend ( path -- stream )
-
-HOOK: <file-appender> io-backend ( path -- stream )
-
-HOOK: delete-file io-backend ( path -- )
-
-HOOK: rename-file io-backend ( from to -- )
-
-HOOK: make-directory io-backend ( path -- )
-
-HOOK: delete-directory io-backend ( path -- )
-
 : path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
 
-HOOK: root-directory? io-backend ( path -- ? )
-
-M: object root-directory? ( path -- ? ) path-separator? ;
-
 : right-trim-separators ( str -- newstr )
     [ path-separator? ] right-trim ;
 
@@ -39,33 +18,15 @@ M: object root-directory? ( path -- ? ) path-separator? ;
     >r right-trim-separators "/" r>
     left-trim-separators 3append ;
 
-: stat ( path -- directory? permissions length modified )
-    normalize-pathname (stat) ;
-
-: file-length ( path -- n ) stat 4array third ;
-
-: file-modified ( path -- n ) stat >r 3drop r> ; inline
-
-: exists? ( path -- ? ) file-modified >boolean ;
-
-: directory? ( path -- ? ) stat 3drop ;
-
-: special-directory? ( name -- ? )
-    { "." ".." } member? ;
-
-: fixup-directory ( path seq -- newseq )
-    [
-        dup string?
-        [ tuck path+ directory? 2array ] [ nip ] if
-    ] with map
-    [ first special-directory? not ] subset ;
-
-: directory ( path -- seq )
-    normalize-directory dup (directory) fixup-directory ;
-
 : last-path-separator ( path -- n ? )
     [ length 1- ] keep [ path-separator? ] find-last* ;
 
+HOOK: root-directory? io-backend ( path -- ? )
+
+M: object root-directory? ( path -- ? ) path-separator? ;
+
+: special-directory? ( name -- ? ) { "." ".." } member? ;
+
 TUPLE: no-parent-directory path ;
 
 : no-parent-directory ( path -- * )
@@ -89,15 +50,30 @@ TUPLE: no-parent-directory path ;
         { [ t ] [ drop ] }
     } cond ;
 
-: resource-path ( path -- newpath )
+! File metadata
-    \ resource-path get [ image parent-directory ] unless*
+: stat ( path -- directory? permissions length modified )
-    swap path+ ;
+    normalize-pathname (stat) ;
 
-: ?resource-path ( path -- newpath )
+: file-length ( path -- n ) stat drop 2nip ;
-    "resource:" ?head [ resource-path ] when ;
 
-: resource-exists? ( path -- ? )
+: file-modified ( path -- n ) stat >r 3drop r> ;
-    ?resource-path exists? ;
+
+: file-permissions ( path -- perm ) stat 2drop nip ;
+
+: exists? ( path -- ? ) file-modified >boolean ;
+
+: directory? ( path -- ? ) stat 3drop ;
+
+! Current working directory
+HOOK: cd io-backend ( path -- )
+
+HOOK: cwd io-backend ( -- path )
+
+: with-directory ( path quot -- )
+    swap cd cwd [ cd ] curry [ ] cleanup ; inline
+
+! Creating directories
+HOOK: make-directory io-backend ( path -- )
 
 : make-directories ( path -- )
     normalize-pathname right-trim-separators {
@@ -111,35 +87,102 @@ TUPLE: no-parent-directory path ;
         ] }
     } cond drop ;
 
+! Directory listings
+: fixup-directory ( path seq -- newseq )
+    [
+        dup string?
+        [ tuck path+ directory? 2array ] [ nip ] if
+    ] with map
+    [ first special-directory? not ] subset ;
+
+: directory ( path -- seq )
+    normalize-directory dup (directory) fixup-directory ;
+
+: directory* ( path -- seq )
+    dup directory [ first2 >r path+ r> 2array ] with map ;
+
+! Touching files
+HOOK: touch-file io-backend ( path -- )
+
+! Deleting files
+HOOK: delete-file io-backend ( path -- )
+
+HOOK: delete-directory io-backend ( path -- )
+
+: (delete-tree) ( path dir? -- )
+    [
+        dup directory* [ (delete-tree) ] assoc-each
+        delete-directory
+    ] [ delete-file ] if ;
+
+: delete-tree ( path -- )
+    dup directory? (delete-tree) ;
+
+: to-directory over file-name path+ ;
+
+! Moving and renaming files
+HOOK: move-file io-backend ( from to -- )
+
+: move-file-to ( from to -- )
+    to-directory move-file ;
+
+: move-files-to ( files to -- )
+    [ move-file-to ] curry each ;
+
+! Copying files
 HOOK: copy-file io-backend ( from to -- )
 
-M: object copy-file
+: copy-file-to ( from to -- )
-    dup parent-directory make-directories
+    to-directory copy-file ;
-    <file-writer> [
-        swap <file-reader> [
-            swap stream-copy
-        ] with-disposal
-    ] with-disposal ;
 
-: copy-directory ( from to -- )
+DEFER: copy-tree-to
+
+: copy-tree ( from to -- )
+    over directory? [
         dup make-directories
         >r dup directory swap r> [
-        >r >r first r> over path+ r> rot path+ copy-file
+            >r swap first path+ r> copy-tree-to
-    ] 2curry each ;
+        ] 2curry each
+    ] [
+        copy-file
+    ] if ;
 
-: home ( -- dir )
+: copy-tree-to ( from to -- )
-    {
+    to-directory copy-tree ;
-        { [ winnt? ] [ "USERPROFILE" os-env ] }
-        { [ wince? ] [ "" resource-path ] }
-        { [ unix? ] [ "HOME" os-env ] }
-    } cond ;
 
+! Special paths
+: resource-path ( path -- newpath )
+    \ resource-path get [ image parent-directory ] unless*
+    swap path+ ;
+
+: ?resource-path ( path -- newpath )
+    "resource:" ?head [ resource-path ] when ;
+
+: resource-exists? ( path -- ? )
+    ?resource-path exists? ;
+
+: temp-directory ( -- path )
+    "temp" resource-path
+    dup exists? not
+      [ dup make-directory ]
+    when ;
+
+: temp-file ( name -- path ) temp-directory swap path+ ;
+
+! Pathname presentations
 TUPLE: pathname string ;
 
 C: <pathname> pathname
 
 M: pathname <=> [ pathname-string ] compare ;
 
+! Streams
+HOOK: <file-reader> io-backend ( path -- stream )
+
+HOOK: <file-writer> io-backend ( path -- stream )
+
+HOOK: <file-appender> io-backend ( path -- stream )
+
 : file-lines ( path -- seq ) <file-reader> lines ;
 
 : file-contents ( path -- str )
@@ -155,10 +198,10 @@ M: pathname <=> [ pathname-string ] compare ;
 : with-file-appender ( path quot -- )
     >r <file-appender> r> with-stream ; inline
 
-: temp-directory ( -- path )
+! Home directory
-    "temp" resource-path
+: home ( -- dir )
-    dup exists? not
+    {
-      [ dup make-directory ]
+        { [ winnt? ] [ "USERPROFILE" os-env ] }
-    when ;
+        { [ wince? ] [ "" resource-path ] }
-
+        { [ unix? ] [ "HOME" os-env ] }
-: temp-file ( name -- path ) temp-directory swap path+ ;
+    } cond ;

core/listener/listener.factor

@@ -62,11 +62,7 @@ M: duplex-stream stream-read-quot
     [ quit-flag off ]
     [ listen until-quit ] if ; inline
 
-: print-banner ( -- )
-    "Factor #" write build number>string write
-    " on " write os write "/" write cpu print ;
-
 : listener ( -- )
-    print-banner [ until-quit ] with-interactive-vocabs ;
+    [ until-quit ] with-interactive-vocabs ;
 
 MAIN: listener

core/syntax/syntax-docs.factor

@@ -163,7 +163,7 @@ ARTICLE: "syntax-byte-vectors" "Byte vector syntax"
 
 ARTICLE: "syntax-pathnames" "Pathname syntax"
 { $subsection POSTPONE: P" }
-"Pathnames are documented in " { $link "file-streams" } "." ;
+"Pathnames are documented in " { $link "pathnames" } "." ;
 
 ARTICLE: "syntax-literals" "Literals"
 "Many different types of objects can be constructed at parse time via literal syntax. Numbers are a special case since support for reading them is built-in to the parser. All other literals are constructed via parsing words."

core/system/system-docs.factor

@@ -29,7 +29,7 @@ ARTICLE: "os" "System interface"
 { $subsection millis }
 "Exiting the Factor VM:"
 { $subsection exit }
-{ $see-also "file-streams" "network-streams" "io.launcher" "io.mmap" } ;
+{ $see-also "io.files" "network-streams" "io.launcher" "io.mmap" } ;
 
 ABOUT: "os"
 

extra/help/handbook/handbook.factor

@@ -172,22 +172,23 @@ ARTICLE: "collections" "Collections"
 USING: io.sockets io.launcher io.mmap io.monitors ;
 
 ARTICLE: "io" "Input and output"
+{ $heading "Streams" }
 { $subsection "streams" }
-"External streams:"
-{ $subsection "file-streams" }
-{ $subsection "network-streams" }
 "Wrapper streams:"
 { $subsection "io.streams.duplex" }
 { $subsection "io.streams.lines" }
 { $subsection "io.streams.plain" }
 { $subsection "io.streams.string" }
-"Stream utilities:"
+"Utilities:"
 { $subsection "stream-binary" }
 { $subsection "styles" }
-"Advanced features:"
+{ $heading "Files" }
-{ $subsection "io.launcher" }
+{ $subsection "io.files" }
 { $subsection "io.mmap" }
 { $subsection "io.monitors" }
+{ $heading "Other features" }
+{ $subsection "network-streams" }
+{ $subsection "io.launcher" }
 { $subsection "io.timeouts" } ;
 
 ARTICLE: "tools" "Developer tools"

extra/io/unix/files/files.factor

@@ -37,7 +37,15 @@ M: unix-io <file-writer> ( path -- stream )
 M: unix-io <file-appender> ( path -- stream )
     open-append <writer> ;
 
-M: unix-io rename-file ( from to -- )
+: touch-mode
+    { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
+
+M: unix-io touch-file ( path -- )
+    touch-mode file-mode open
+    dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when
+    close ;
+
+M: unix-io move-file ( from to -- )
     rename io-error ;
 
 M: unix-io delete-file ( path -- )
@@ -48,3 +56,14 @@ M: unix-io make-directory ( path -- )
 
 M: unix-io delete-directory ( path -- )
     rmdir io-error ;
+
+: (copy-file) ( from to -- )
+    dup parent-directory make-directories
+    <file-writer> [
+        swap <file-reader> [
+            swap stream-copy
+        ] with-disposal
+    ] with-disposal ;
+
+M: unix-io copy-file ( from to -- )
+    over file-permissions >r (copy-file) r> chmod io-error ;

extra/io/windows/nt/files/files.factor

@@ -59,7 +59,8 @@ M: windows-nt-io root-directory? ( path -- ? )
     } cond ;
 
 M: windows-nt-io normalize-pathname ( string -- string )
-    dup string? [ "pathname must be a string" throw ] unless
+    dup string? [ "Pathname must be a string" throw ] unless
+    dup empty? [ "Empty pathname" throw ] when
     { { CHAR: / CHAR: \\ } } substitute
     cwd swap windows-path+
     [ "/\\." member? ] right-trim

extra/io/windows/nt/monitors/monitors.factor

@@ -5,7 +5,7 @@ io.windows.nt.backend kernel math windows windows.kernel32
 windows.types libc assocs alien namespaces continuations
 io.monitors io.monitors.private io.nonblocking io.buffers
 io.files io.timeouts io sequences hashtables sorting arrays
-combinators ;
+combinators math.bitfields ;
 IN: io.windows.nt.monitors
 
 : open-directory ( path -- handle )
@@ -13,7 +13,7 @@ IN: io.windows.nt.monitors
     share-mode
     f
     OPEN_EXISTING
-    FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED bitor
+    { FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED } flags
     f
     CreateFile
     dup invalid-handle?

extra/io/windows/windows.factor

@@ -28,7 +28,7 @@ HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
 HOOK: add-completion io-backend ( port -- )
 
 M: windows-io normalize-directory ( string -- string )
-    "\\" ?tail drop "\\*" append ;
+    normalize-pathname "\\" ?tail drop "\\*" append ;
 
 : share-mode ( -- fixnum )
     {
@@ -121,7 +121,7 @@ M: windows-io <file-writer> ( path -- stream )
 M: windows-io <file-appender> ( path -- stream )
     open-append <win32-file> <writer> ;
 
-M: windows-io rename-file ( from to -- )
+M: windows-io move-file ( from to -- )
     [ normalize-pathname ] 2apply MoveFile win32-error=0/f ;
 
 M: windows-io delete-file ( path -- )

extra/logging/server/server.factor

@@ -68,11 +68,11 @@ SYMBOL: log-files
 
 : delete-oldest keep-logs log# ?delete-file ;
 
-: ?rename-file ( old new -- )
+: ?move-file ( old new -- )
-    over exists? [ rename-file ] [ 2drop ] if ;
+    over exists? [ move-file ] [ 2drop ] if ;
 
 : advance-log ( path n -- )
-    [ 1- log# ] 2keep log# ?rename-file ;
+    [ 1- log# ] 2keep log# ?move-file ;
 
 : rotate-log ( service -- )
     dup close-log

extra/tools/deploy/macosx/macosx.factor

@@ -1,36 +1,22 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.files io.launcher kernel namespaces sequences
+USING: io io.files kernel namespaces sequences system
-system tools.deploy.backend tools.deploy.config assocs
+tools.deploy.backend tools.deploy.config assocs hashtables
-hashtables prettyprint io.unix.backend cocoa
+prettyprint cocoa cocoa.application cocoa.classes cocoa.plists ;
-cocoa.application cocoa.classes cocoa.plists qualified ;
-QUALIFIED: unix
 IN: tools.deploy.macosx
 
-: touch ( path -- )
-    { "touch" } swap add try-process ;
-
-: rm ( path -- )
-    { "rm" "-rf" } swap add try-process ;
-
 : bundle-dir ( -- dir )
     vm parent-directory parent-directory ;
 
 : copy-bundle-dir ( name dir -- )
-    bundle-dir over path+ -rot
+    bundle-dir swap path+ swap "Contents" path+ copy-tree ;
-    >r "Contents" path+ r> path+ copy-directory ;
-
-: chmod ( path perms -- )
-    unix:chmod io-error ;
 
 : copy-vm ( executable bundle-name -- vm )
-    "Contents/MacOS/" path+ swap path+ vm swap
+    "Contents/MacOS/" path+ swap path+ vm swap copy-file ;
-    [ copy-file ] keep
-    [ OCT: 755 chmod ] keep ;
 
 : copy-fonts ( name -- )
     "fonts/" resource-path
-    swap "Contents/Resources/fonts/" path+ copy-directory ;
+    swap "Contents/Resources/" path+ copy-tree ;
 
 : print-app-plist ( executable bundle-name -- )
     [
@@ -75,7 +61,7 @@ M: macosx-deploy-implementation deploy* ( vocab -- )
     ".app deploy tool" assert.app
     "." resource-path cd
     dup deploy-config [
-        bundle-name rm
+        bundle-name delete-tree
         [ bundle-name create-app-dir ] keep
         [ bundle-name deploy.app-image ] keep
         namespace make-deploy-image

extra/tools/deploy/windows/windows.factor

@@ -9,8 +9,7 @@ IN: tools.deploy.windows
     swap path+ ".exe" append vm swap [ copy-file ] keep ;
 
 : copy-fonts ( bundle-name -- )
-    "fonts/" resource-path
+    "fonts/" resource-path swap copy-tree ;
-    swap "fonts/" path+ copy-directory ;
 
 : copy-dlls ( bundle-name -- )
     {
@@ -18,7 +17,7 @@ IN: tools.deploy.windows
         "zlib1.dll"
         "factor-nt.dll"
     } [
-        dup resource-path -rot path+ copy-file
+        resource-path swap copy-file-to
     ] with each ;
 
 : create-exe-dir ( vocab bundle-name -- vm )

extra/unix/unix.factor

@@ -102,6 +102,8 @@ C-STRUCT: timespec
 
 : MAP_FAILED -1 <alien> ; inline
 
+: EEXIST 17 ; inline
+
 ! ! ! Unix functions
 LIBRARY: factor
 FUNCTION: int err_no ( ) ;

vm/os-windows.c

@@ -174,7 +174,7 @@ DEFINE_PRIMITIVE(read_dir)
 			GROWABLE_ADD(result,pair);
 		}
 		while (FindNextFile(dir, &find_data));
-		CloseHandle(dir);
+		FindClose(dir);
 	}
 
 	UNREGISTER_ROOT(result);