From fef5ebec013bf686b267f80cfd42c95d1781cc62 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 Feb 2008 14:59:15 -0600 Subject: [PATCH] io.files overhaul --- core/io/files/files-docs.factor | 55 ++++- core/io/files/files-tests.factor | 97 +++++++-- core/io/files/files.factor | 199 +++++++++++-------- core/listener/listener.factor | 6 +- core/syntax/syntax-docs.factor | 2 +- core/system/system-docs.factor | 2 +- extra/help/handbook/handbook.factor | 15 +- extra/io/unix/files/files.factor | 21 +- extra/io/windows/nt/files/files.factor | 3 +- extra/io/windows/nt/monitors/monitors.factor | 4 +- extra/io/windows/windows.factor | 4 +- extra/logging/server/server.factor | 6 +- extra/tools/deploy/macosx/macosx.factor | 28 +-- extra/tools/deploy/windows/windows.factor | 5 +- extra/unix/unix.factor | 2 + vm/os-windows.c | 2 +- 16 files changed, 295 insertions(+), 156 deletions(-) diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 185fa1436b..743a2d1b99 100755 --- a/core/io/files/files-docs.factor +++ b/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 } { $subsection } { $subsection } +"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 } ; + +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 delete-file } +{ $subsection directory* } +"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 resource-path } -{ $subsection ?resource-path } -"Pathname presentations:" -{ $subsection pathname } -{ $subsection } +{ $subsection with-directory } +{ $subsection home } { $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: { $values { "path" "a pathname string" } { "stream" "an input stream" } } { $description "Outputs an input stream for reading from the specified pathname." } diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index a111070151..92e148a854 100755 --- a/core/io/files/files-tests.factor +++ b/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 [ + "test-foo.txt" temp-file [ "Hello appender." print ] with-stream ] unit-test [ ] [ - "test-bar.txt" resource-path [ + "test-bar.txt" temp-file [ "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 dispose + "test-blah/fooz" temp-file 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 -[ t ] [ "quux-test.txt" resource-path exists? ] unit-test +[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] 2apply move-file ] 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 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 7dbe8c229e..7e14ffc4e3 100755 --- a/core/io/files/files.factor +++ b/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 -- ) - -HOOK: cwd io-backend ( -- path ) - -HOOK: io-backend ( path -- stream ) - -HOOK: io-backend ( path -- stream ) - -HOOK: 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 -- ) - +! Pathnames : 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 ) - \ resource-path get [ image parent-directory ] unless* - swap path+ ; +! File metadata +: stat ( path -- directory? permissions length modified ) + normalize-pathname (stat) ; -: ?resource-path ( path -- newpath ) - "resource:" ?head [ resource-path ] when ; +: file-length ( path -- n ) stat drop 2nip ; -: resource-exists? ( path -- ? ) - ?resource-path exists? ; +: file-modified ( path -- n ) stat >r 3drop r> ; + +: 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 - dup parent-directory make-directories - [ - swap [ - swap stream-copy - ] with-disposal - ] with-disposal ; +: copy-file-to ( from to -- ) + to-directory copy-file ; -: copy-directory ( from to -- ) - dup make-directories - >r dup directory swap r> [ - >r >r first r> over path+ r> rot path+ copy-file - ] 2curry each ; +DEFER: copy-tree-to -: home ( -- dir ) - { - { [ winnt? ] [ "USERPROFILE" os-env ] } - { [ wince? ] [ "" resource-path ] } - { [ unix? ] [ "HOME" os-env ] } - } cond ; +: copy-tree ( from to -- ) + over directory? [ + dup make-directories + >r dup directory swap r> [ + >r swap first path+ r> copy-tree-to + ] 2curry each + ] [ + copy-file + ] if ; +: copy-tree-to ( from to -- ) + to-directory copy-tree ; + +! 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 M: pathname <=> [ pathname-string ] compare ; +! Streams +HOOK: io-backend ( path -- stream ) + +HOOK: io-backend ( path -- stream ) + +HOOK: io-backend ( path -- stream ) + : file-lines ( path -- seq ) lines ; : file-contents ( path -- str ) @@ -155,10 +198,10 @@ M: pathname <=> [ pathname-string ] compare ; : with-file-appender ( path quot -- ) >r r> with-stream ; inline -: temp-directory ( -- path ) - "temp" resource-path - dup exists? not - [ dup make-directory ] - when ; - -: temp-file ( name -- path ) temp-directory swap path+ ; \ No newline at end of file +! Home directory +: home ( -- dir ) + { + { [ winnt? ] [ "USERPROFILE" os-env ] } + { [ wince? ] [ "" resource-path ] } + { [ unix? ] [ "HOME" os-env ] } + } cond ; \ No newline at end of file diff --git a/core/listener/listener.factor b/core/listener/listener.factor index 110f0d3ee1..fe1471716d 100755 --- a/core/listener/listener.factor +++ b/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 diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 95a00f3801..eeb3f85962 100755 --- a/core/syntax/syntax-docs.factor +++ b/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." diff --git a/core/system/system-docs.factor b/core/system/system-docs.factor index bdd04307df..facfd2b48d 100755 --- a/core/system/system-docs.factor +++ b/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" diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 422d7ef1e8..6660ddf218 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -171,23 +171,24 @@ ARTICLE: "collections" "Collections" USING: io.sockets io.launcher io.mmap io.monitors ; -ARTICLE: "io" "Input and output" +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:" -{ $subsection "io.launcher" } +{ $heading "Files" } +{ $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" diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 3bf0e3f897..41a6cb140f 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -37,7 +37,15 @@ M: unix-io ( path -- stream ) M: unix-io ( path -- stream ) open-append ; -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 + [ + swap [ + swap stream-copy + ] with-disposal + ] with-disposal ; + +M: unix-io copy-file ( from to -- ) + over file-permissions >r (copy-file) r> chmod io-error ; diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 3541243016..dda94da892 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/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 diff --git a/extra/io/windows/nt/monitors/monitors.factor b/extra/io/windows/nt/monitors/monitors.factor index eff3c250dc..d14dff8c22 100755 --- a/extra/io/windows/nt/monitors/monitors.factor +++ b/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? diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index ee3f744bb0..9f2f2db0a5 100755 --- a/extra/io/windows/windows.factor +++ b/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 ( path -- stream ) M: windows-io ( path -- stream ) open-append ; -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 -- ) diff --git a/extra/logging/server/server.factor b/extra/logging/server/server.factor index 94d112583a..99f637f4a0 100755 --- a/extra/logging/server/server.factor +++ b/extra/logging/server/server.factor @@ -68,11 +68,11 @@ SYMBOL: log-files : delete-oldest keep-logs log# ?delete-file ; -: ?rename-file ( old new -- ) - over exists? [ rename-file ] [ 2drop ] if ; +: ?move-file ( old new -- ) + 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 diff --git a/extra/tools/deploy/macosx/macosx.factor b/extra/tools/deploy/macosx/macosx.factor index eb1a4af4a7..f331a687a0 100755 --- a/extra/tools/deploy/macosx/macosx.factor +++ b/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 -system tools.deploy.backend tools.deploy.config assocs -hashtables prettyprint io.unix.backend cocoa -cocoa.application cocoa.classes cocoa.plists qualified ; -QUALIFIED: unix +USING: io io.files kernel namespaces sequences system +tools.deploy.backend tools.deploy.config assocs hashtables +prettyprint cocoa cocoa.application cocoa.classes cocoa.plists ; 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 - >r "Contents" path+ r> path+ copy-directory ; - -: chmod ( path perms -- ) - unix:chmod io-error ; + bundle-dir swap path+ swap "Contents" path+ copy-tree ; : copy-vm ( executable bundle-name -- vm ) - "Contents/MacOS/" path+ swap path+ vm swap - [ copy-file ] keep - [ OCT: 755 chmod ] keep ; + "Contents/MacOS/" path+ swap path+ vm swap copy-file ; : 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 diff --git a/extra/tools/deploy/windows/windows.factor b/extra/tools/deploy/windows/windows.factor index 00dbc2e4df..f78b4d030e 100755 --- a/extra/tools/deploy/windows/windows.factor +++ b/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 - swap "fonts/" path+ copy-directory ; + "fonts/" resource-path swap copy-tree ; : 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 ) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 7df41069e0..e8716ee074 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -102,6 +102,8 @@ C-STRUCT: timespec : MAP_FAILED -1 ; inline +: EEXIST 17 ; inline + ! ! ! Unix functions LIBRARY: factor FUNCTION: int err_no ( ) ; diff --git a/vm/os-windows.c b/vm/os-windows.c index a60339c578..e28debd449 100755 --- a/vm/os-windows.c +++ b/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);