steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Eduardo Cavazos 2008-04-01 18:52:55 -06:00
parent 8047115746 7b457218ab
commit b5083a37ef
19 changed files with 87 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/io/backend/backend-tests.factor Normal file → Executable file
View File

@ -1,4 +1,4 @@
IN: io.backend.tests IN: io.backend.tests
USING: tools.test io.backend kernel ; USING: tools.test io.backend kernel ;
[ ] [ "a" normalize-pathname drop ] unit-test [ ] [ "a" normalize-path drop ] unit-test

6
core/io/backend/backend.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: init kernel system namespaces io io.encodings USING: init kernel system namespaces io io.encodings
io.encodings.utf8 init assocs ; io.encodings.utf8 init assocs splitting ;
IN: io.backend IN: io.backend
SYMBOL: io-backend SYMBOL: io-backend
@ -18,9 +18,9 @@ HOOK: io-multiplex io-backend ( ms -- )
HOOK: normalize-directory io-backend ( str -- newstr ) HOOK: normalize-directory io-backend ( str -- newstr )
HOOK: normalize-pathname io-backend ( str -- newstr ) HOOK: normalize-path io-backend ( str -- newstr )
M: object normalize-directory normalize-pathname ; M: object normalize-directory normalize-path ;
: set-io-backend ( io-backend -- ) : set-io-backend ( io-backend -- )
io-backend set-global init-io init-stdio io-backend set-global init-io init-stdio

2
core/io/files/files-docs.factor
View File

@ -252,7 +252,7 @@ HELP: normalize-directory
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } } { $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
{ $description "Called by the " { $link directory } " word to prepare a pathname before passing it to the " { $link (directory) } " primitive." } ; { $description "Called by the " { $link directory } " word to prepare a pathname before passing it to the " { $link (directory) } " primitive." } ;
HELP: normalize-pathname HELP: normalize-path
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } } { $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
{ $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ; { $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;

6
core/io/files/files-tests.factor
View File

@ -220,8 +220,6 @@ io.encodings.utf8 ;
[ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test [ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
[ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test [ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test
[ "/lib" ] [ "/usr/" "/lib" append-path ] unit-test
[ "/lib/" ] [ "/usr/" "/lib/" append-path ] unit-test
[ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test [ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test
[ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test [ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test
[ "/lib" ] [ "/usr" "../lib" append-path ] unit-test [ "/lib" ] [ "/usr" "../lib" append-path ] unit-test
@ -239,9 +237,6 @@ io.encodings.utf8 ;
[ "lib" ] [ "" "lib" append-path ] unit-test [ "lib" ] [ "" "lib" append-path ] unit-test
[ "lib" ] [ "" "./lib" append-path ] unit-test [ "lib" ] [ "" "./lib" append-path ] unit-test
[ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test
[ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test
[ "foo/bar/." parent-directory ] must-fail [ "foo/bar/." parent-directory ] must-fail
[ "foo/bar/./" parent-directory ] must-fail [ "foo/bar/./" parent-directory ] must-fail
[ "foo/bar/baz/.." parent-directory ] must-fail [ "foo/bar/baz/.." parent-directory ] must-fail
@ -263,5 +258,4 @@ io.encodings.utf8 ;
[ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test [ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test
[ t ] [ "resource:core" absolute-path? ] unit-test [ t ] [ "resource:core" absolute-path? ] unit-test
[ t ] [ "/foo" absolute-path? ] unit-test
[ f ] [ "" absolute-path? ] unit-test [ f ] [ "" absolute-path? ] unit-test

48
core/io/files/files.factor
View File

@ -13,13 +13,13 @@ HOOK: (file-writer) io-backend ( path -- stream )
HOOK: (file-appender) io-backend ( path -- stream ) HOOK: (file-appender) io-backend ( path -- stream )
: <file-reader> ( path encoding -- stream ) : <file-reader> ( path encoding -- stream )
swap normalize-pathname (file-reader) swap <decoder> ; swap normalize-path (file-reader) swap <decoder> ;
: <file-writer> ( path encoding -- stream ) : <file-writer> ( path encoding -- stream )
swap normalize-pathname (file-writer) swap <encoder> ; swap normalize-path (file-writer) swap <encoder> ;
: <file-appender> ( path encoding -- stream ) : <file-appender> ( path encoding -- stream )
swap normalize-pathname (file-appender) swap <encoder> ; swap normalize-path (file-appender) swap <encoder> ;
: file-lines ( path encoding -- seq ) : file-lines ( path encoding -- seq )
<file-reader> lines ; <file-reader> lines ;
@ -102,6 +102,7 @@ PRIVATE>
: windows-absolute-path? ( path -- path ? ) : windows-absolute-path? ( path -- path ? )
{ {
{ [ dup "\\\\?\\" head? ] [ t ] }
{ [ dup length 2 < ] [ f ] } { [ dup length 2 < ] [ f ] }
{ [ dup second CHAR: : = ] [ t ] } { [ dup second CHAR: : = ] [ t ] }
{ [ t ] [ f ] } { [ t ] [ f ] }
@ -111,8 +112,8 @@ PRIVATE>
{ {
{ [ dup empty? ] [ f ] } { [ dup empty? ] [ f ] }
{ [ dup "resource:" head? ] [ t ] } { [ dup "resource:" head? ] [ t ] }
{ [ dup first path-separator? ] [ t ] }
{ [ windows? ] [ windows-absolute-path? ] } { [ windows? ] [ windows-absolute-path? ] }
{ [ dup first path-separator? ] [ t ] }
{ [ t ] [ f ] } { [ t ] [ f ] }
} cond nip ; } cond nip ;
@ -126,6 +127,9 @@ PRIVATE>
2 tail left-trim-separators 2 tail left-trim-separators
>r parent-directory r> append-path >r parent-directory r> append-path
] } ] }
{ [ over absolute-path? over first path-separator? and ] [
>r 2 head r> append
] }
{ [ t ] [ { [ t ] [
>r right-trim-separators "/" r> >r right-trim-separators "/" r>
left-trim-separators 3append left-trim-separators 3append
@ -167,7 +171,7 @@ SYMBOL: +unknown+
! File metadata ! File metadata
: exists? ( path -- ? ) : exists? ( path -- ? )
normalize-pathname (exists?) ; normalize-path (exists?) ;
: directory? ( path -- ? ) : directory? ( path -- ? )
file-info file-info-type +directory+ = ; file-info file-info-type +directory+ = ;
@ -183,18 +187,33 @@ M: object cwd ( -- path ) "." ;
[ cwd current-directory set-global ] "io.files" add-init-hook [ cwd current-directory set-global ] "io.files" add-init-hook
: resource-path ( path -- newpath )
"resource-path" get [ image parent-directory ] unless*
prepend-path ;
: (normalize-path) ( path -- path' )
"resource:" ?head [
left-trim-separators resource-path
(normalize-path)
] [
current-directory get prepend-path
] if ;
M: object normalize-path ( path -- path' )
(normalize-path) ;
: with-directory ( path quot -- ) : with-directory ( path quot -- )
>r normalize-pathname r> >r (normalize-path) r>
current-directory swap with-variable ; inline current-directory swap with-variable ; inline
: set-current-directory ( path -- ) : set-current-directory ( path -- )
normalize-pathname current-directory set ; normalize-path current-directory set ;
! Creating directories ! Creating directories
HOOK: make-directory io-backend ( path -- ) HOOK: make-directory io-backend ( path -- )
: make-directories ( path -- ) : make-directories ( path -- )
normalize-pathname right-trim-separators { normalize-path right-trim-separators {
{ [ dup "." = ] [ ] } { [ dup "." = ] [ ] }
{ [ dup root-directory? ] [ ] } { [ dup root-directory? ] [ ] }
{ [ dup empty? ] [ ] } { [ dup empty? ] [ ] }
@ -267,7 +286,7 @@ M: object copy-file
DEFER: copy-tree-into DEFER: copy-tree-into
: copy-tree ( from to -- ) : copy-tree ( from to -- )
normalize-pathname normalize-path
over link-info type>> over link-info type>>
{ {
{ +symbolic-link+ [ copy-link ] } { +symbolic-link+ [ copy-link ] }
@ -286,9 +305,6 @@ DEFER: copy-tree-into
[ copy-tree-into ] curry each ; [ copy-tree-into ] curry each ;
! Special paths ! Special paths
: resource-path ( path -- newpath )
"resource-path" get [ image parent-directory ] unless*
prepend-path ;
: temp-directory ( -- path ) : temp-directory ( -- path )
"temp" resource-path dup make-directories ; "temp" resource-path dup make-directories ;
@ -296,14 +312,6 @@ DEFER: copy-tree-into
: temp-file ( name -- path ) : temp-file ( name -- path )
temp-directory prepend-path ; temp-directory prepend-path ;
M: object normalize-pathname ( path -- path' )
"resource:" ?head [
left-trim-separators resource-path
normalize-pathname
] [
current-directory get prepend-path
] if ;
! Pathname presentations ! Pathname presentations
TUPLE: pathname string ; TUPLE: pathname string ;

2
extra/cairo/png/png.factor
View File

@ -24,7 +24,7 @@ ERROR: cairo-error string ;
} cond ; } cond ;
: <png> ( path -- png ) : <png> ( path -- png )
normalize-pathname normalize-path
cairo_image_surface_create_from_png cairo_image_surface_create_from_png
dup cairo_surface_status cairo-png-error dup cairo_surface_status cairo-png-error
dup [ cairo_image_surface_get_width check-zero ] dup [ cairo_image_surface_get_width check-zero ]

2
extra/classes/singleton/singleton-tests.factor
View File

@ -1,4 +1,4 @@
USING: kernel singleton tools.test prettyprint io.streams.string ; USING: kernel classes.singleton tools.test prettyprint io.streams.string ;
IN: classes.singleton.tests IN: classes.singleton.tests
[ ] [ SINGLETON: bzzt ] unit-test [ ] [ SINGLETON: bzzt ] unit-test

2
extra/editors/editors.factor
View File

@ -26,7 +26,7 @@ SYMBOL: edit-hook
require ; require ;
: edit-location ( file line -- ) : edit-location ( file line -- )
>r normalize-pathname "\\\\?\\" ?head drop r> >r (normalize-path) "\\\\?\\" ?head drop r>
edit-hook get [ call ] [ no-edit-hook edit-location ] if* ; edit-hook get [ call ] [ no-edit-hook edit-location ] if* ;
: edit ( defspec -- ) : edit ( defspec -- )

2
extra/io/sockets/sockets.factor
View File

@ -7,7 +7,7 @@ IN: io.sockets
TUPLE: local path ; TUPLE: local path ;
: <local> ( path -- addrspec ) : <local> ( path -- addrspec )
normalize-pathname local construct-boa ; normalize-path local construct-boa ;
TUPLE: inet4 host port ; TUPLE: inet4 host port ;

6
extra/io/unix/files/files-tests.factor
View File

@ -21,3 +21,9 @@ IN: io.unix.files.tests
[ "/lib/" ] [ "/" "../lib/" append-path ] unit-test [ "/lib/" ] [ "/" "../lib/" append-path ] unit-test
[ "/lib" ] [ "/" "../../lib" append-path ] unit-test [ "/lib" ] [ "/" "../../lib" append-path ] unit-test
[ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test [ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test
{ [ "/lib" ] [ "/usr/" "/lib" append-path ] }
{ [ "/lib/" ] [ "/usr/" "/lib/" append-path ] }
{ [ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] }
{ [ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] }
{ [ t ] [ "/foo" absolute-path? ] }

20
extra/io/unix/files/files.factor
View File

@ -43,22 +43,22 @@ M: unix-io (file-appender) ( path -- stream )
{ O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
M: unix-io touch-file ( path -- ) M: unix-io touch-file ( path -- )
normalize-pathname normalize-path
touch-mode file-mode open touch-mode file-mode open
dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when
close ; close ;
M: unix-io move-file ( from to -- ) M: unix-io move-file ( from to -- )
[ normalize-pathname ] bi@ rename io-error ; [ normalize-path ] bi@ rename io-error ;
M: unix-io delete-file ( path -- ) M: unix-io delete-file ( path -- )
normalize-pathname unlink io-error ; normalize-path unlink io-error ;
M: unix-io make-directory ( path -- ) M: unix-io make-directory ( path -- )
normalize-pathname OCT: 777 mkdir io-error ; normalize-path OCT: 777 mkdir io-error ;
M: unix-io delete-directory ( path -- ) M: unix-io delete-directory ( path -- )
normalize-pathname rmdir io-error ; normalize-path rmdir io-error ;
: (copy-file) ( from to -- ) : (copy-file) ( from to -- )
dup parent-directory make-directories dup parent-directory make-directories
@ -69,7 +69,7 @@ M: unix-io delete-directory ( path -- )
] with-disposal ; ] with-disposal ;
M: unix-io copy-file ( from to -- ) M: unix-io copy-file ( from to -- )
[ normalize-pathname ] bi@ [ normalize-path ] bi@
[ (copy-file) ] [ (copy-file) ]
[ swap file-info file-info-permissions chmod io-error ] [ swap file-info file-info-permissions chmod io-error ]
2bi ; 2bi ;
@ -96,15 +96,15 @@ M: unix-io copy-file ( from to -- )
\ file-info construct-boa ; \ file-info construct-boa ;
M: unix-io file-info ( path -- info ) M: unix-io file-info ( path -- info )
normalize-pathname stat* stat>file-info ; normalize-path stat* stat>file-info ;
M: unix-io link-info ( path -- info ) M: unix-io link-info ( path -- info )
normalize-pathname lstat* stat>file-info ; normalize-path lstat* stat>file-info ;
M: unix-io make-link ( path1 path2 -- ) M: unix-io make-link ( path1 path2 -- )
normalize-pathname symlink io-error ; normalize-path symlink io-error ;
M: unix-io read-link ( path -- path' ) M: unix-io read-link ( path -- path' )
normalize-pathname normalize-path
PATH_MAX [ <byte-array> tuck ] [ ] bi readlink PATH_MAX [ <byte-array> tuck ] [ ] bi readlink
dup io-error head-slice >string ; dup io-error head-slice >string ;

2
extra/io/unix/launcher/launcher.factor
View File

@ -37,7 +37,7 @@ USE: unix
2nip reset-fd ; 2nip reset-fd ;
: redirect-file ( obj mode fd -- ) : redirect-file ( obj mode fd -- )
>r >r normalize-pathname r> file-mode >r >r normalize-path r> file-mode
open dup io-error r> redirect-fd ; open dup io-error r> redirect-fd ;
: redirect-closed ( obj mode fd -- ) : redirect-closed ( obj mode fd -- )

2
extra/io/windows/ce/files/files.factor
View File

@ -4,7 +4,7 @@ prettyprint sequences strings threads threads.private
windows windows.kernel32 io.windows.ce.backend ; windows windows.kernel32 io.windows.ce.backend ;
IN: windows.ce.files IN: windows.ce.files
! M: windows-ce-io normalize-pathname ( string -- string ) ! M: windows-ce-io normalize-path ( string -- string )
! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ; ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ;
M: windows-ce-io CreateFile-flags ( DWORD -- DWORD ) M: windows-ce-io CreateFile-flags ( DWORD -- DWORD )

8
extra/io/windows/files/files.factor
View File

@ -89,14 +89,14 @@ SYMBOLS: +read-only+ +hidden+ +system+
] if ; ] if ;
M: windows-nt-io file-info ( path -- info ) M: windows-nt-io file-info ( path -- info )
normalize-pathname get-file-information-stat ; normalize-path get-file-information-stat ;
M: windows-nt-io link-info ( path -- info ) M: windows-nt-io link-info ( path -- info )
file-info ; file-info ;
: file-times ( path -- timestamp timestamp timestamp ) : file-times ( path -- timestamp timestamp timestamp )
[ [
normalize-pathname open-existing dup close-always normalize-path open-existing dup close-always
"FILETIME" <c-object> "FILETIME" <c-object>
"FILETIME" <c-object> "FILETIME" <c-object>
"FILETIME" <c-object> "FILETIME" <c-object>
@ -112,7 +112,7 @@ M: windows-nt-io link-info ( path -- info )
#! timestamp order: creation access write #! timestamp order: creation access write
[ [
>r >r >r >r >r >r
normalize-pathname open-existing dup close-always normalize-path open-existing dup close-always
r> r> r> (set-file-times) r> r> r> (set-file-times)
] with-destructors ; ] with-destructors ;
@ -127,7 +127,7 @@ M: windows-nt-io link-info ( path -- info )
M: windows-nt-io touch-file ( path -- ) M: windows-nt-io touch-file ( path -- )
[ [
normalize-pathname normalize-path
maybe-create-file over close-always maybe-create-file over close-always
[ drop ] [ f now dup (set-file-times) ] if [ drop ] [ f now dup (set-file-times) ] if
] with-destructors ; ] with-destructors ;

2
extra/io/windows/launcher/launcher.factor
View File

@ -28,7 +28,7 @@ TUPLE: CreateProcess-args
"PROCESS_INFORMATION" <c-object> >>lpProcessInformation "PROCESS_INFORMATION" <c-object> >>lpProcessInformation
TRUE >>bInheritHandles TRUE >>bInheritHandles
0 >>dwCreateFlags 0 >>dwCreateFlags
current-directory get normalize-pathname >>lpCurrentDirectory ; current-directory get (normalize-path) >>lpCurrentDirectory ;
: call-CreateProcess ( CreateProcess-args -- ) : call-CreateProcess ( CreateProcess-args -- )
{ {

17
extra/io/windows/nt/files/files-tests.factor Normal file → Executable file
View File

@ -1,9 +1,9 @@
USING: io.files kernel tools.test io.backend USING: io.files kernel tools.test io.backend
io.windows.nt.files splitting ; io.windows.nt.files splitting sequences ;
IN: io.windows.nt.files.tests IN: io.windows.nt.files.tests
[ t ] [ "\\foo" absolute-path? ] unit-test [ f ] [ "\\foo" absolute-path? ] unit-test
[ t ] [ "\\\\?\\foo" absolute-path? ] unit-test [ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test
[ t ] [ "c:\\foo" absolute-path? ] unit-test [ t ] [ "c:\\foo" absolute-path? ] unit-test
[ t ] [ "c:" absolute-path? ] unit-test [ t ] [ "c:" absolute-path? ] unit-test
@ -29,19 +29,22 @@ IN: io.windows.nt.files.tests
[ ] [ "" resource-path cd ] unit-test [ ] [ "" resource-path cd ] unit-test
[ "\\foo\\bar" ] [ "/foo/bar" normalize-pathname ":" split1 nip ] unit-test [ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test
[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [ [ "\\\\?\\C:\\builds\\factor\\log.txt" ] [
"C:\\builds\\factor\\12345\\" "C:\\builds\\factor\\12345\\"
"..\\log.txt" append-path normalize-pathname "..\\log.txt" append-path normalize-path
] unit-test ] unit-test
[ "\\\\?\\C:\\builds\\" ] [ [ "\\\\?\\C:\\builds\\" ] [
"C:\\builds\\factor\\12345\\" "C:\\builds\\factor\\12345\\"
"..\\.." append-path normalize-pathname "..\\.." append-path normalize-path
] unit-test ] unit-test
[ "\\\\?\\C:\\builds\\" ] [ [ "\\\\?\\C:\\builds\\" ] [
"C:\\builds\\factor\\12345\\" "C:\\builds\\factor\\12345\\"
"..\\.." append-path normalize-pathname "..\\.." append-path normalize-path
] unit-test ] unit-test
[ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test
[ t ] [ "" resource-path 2 tail exists? ] unit-test

26
extra/io/windows/nt/files/files.factor
View File

@ -36,28 +36,14 @@ ERROR: not-absolute-path ;
} && [ 2 head ] [ not-absolute-path ] if ; } && [ 2 head ] [ not-absolute-path ] if ;
: prepend-prefix ( string -- string' ) : prepend-prefix ( string -- string' )
unicode-prefix prepend ;
ERROR: nonstring-pathname ;
ERROR: empty-pathname ;
M: windows-nt-io normalize-pathname ( string -- string )
"resource:" ?head [
left-trim-separators resource-path
normalize-pathname
] [
dup empty? [ empty-pathname ] when
current-directory get prepend-path
dup unicode-prefix head? [ dup unicode-prefix head? [
dup first path-separator? [
left-trim-separators
current-directory get 2 head
prepend-path
] when
unicode-prefix prepend unicode-prefix prepend
] unless ] unless ;
{ { CHAR: / CHAR: \\ } } substitute ! necessary
] if ; M: windows-nt-io normalize-path ( string -- string' )
(normalize-path)
{ { CHAR: / CHAR: \\ } } substitute
prepend-prefix ;
M: windows-nt-io CreateFile-flags ( DWORD -- DWORD ) M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )
FILE_FLAG_OVERLAPPED bitor ; FILE_FLAG_OVERLAPPED bitor ;

2
extra/io/windows/nt/launcher/launcher.factor
View File

@ -32,7 +32,7 @@ IN: io.windows.nt.launcher
drop 2nip null-pipe ; drop 2nip null-pipe ;
:: redirect-file ( default path access-mode create-mode -- handle ) :: redirect-file ( default path access-mode create-mode -- handle )
path normalize-pathname path normalize-path
access-mode access-mode
share-mode share-mode
security-attributes-inherit security-attributes-inherit

12
extra/io/windows/windows.factor
View File

@ -25,7 +25,7 @@ HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
HOOK: add-completion io-backend ( port -- ) HOOK: add-completion io-backend ( port -- )
M: windows-io normalize-directory ( string -- string ) M: windows-io normalize-directory ( string -- string )
normalize-pathname "\\" ?tail drop "\\*" append ; normalize-path "\\" ?tail drop "\\*" append ;
: share-mode ( -- fixnum ) : share-mode ( -- fixnum )
{ {
@ -135,21 +135,21 @@ M: windows-io (file-appender) ( path -- stream )
open-append <win32-file> <writer> ; open-append <win32-file> <writer> ;
M: windows-io move-file ( from to -- ) M: windows-io move-file ( from to -- )
[ normalize-pathname ] bi@ MoveFile win32-error=0/f ; [ normalize-path ] bi@ MoveFile win32-error=0/f ;
M: windows-io delete-file ( path -- ) M: windows-io delete-file ( path -- )
normalize-pathname DeleteFile win32-error=0/f ; normalize-path DeleteFile win32-error=0/f ;
M: windows-io copy-file ( from to -- ) M: windows-io copy-file ( from to -- )
dup parent-directory make-directories dup parent-directory make-directories
[ normalize-pathname ] bi@ 0 CopyFile win32-error=0/f ; [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ;
M: windows-io make-directory ( path -- ) M: windows-io make-directory ( path -- )
normalize-pathname normalize-path
f CreateDirectory win32-error=0/f ; f CreateDirectory win32-error=0/f ;
M: windows-io delete-directory ( path -- ) M: windows-io delete-directory ( path -- )
normalize-pathname normalize-path
RemoveDirectory win32-error=0/f ; RemoveDirectory win32-error=0/f ;
HOOK: WSASocket-flags io-backend ( -- DWORD ) HOOK: WSASocket-flags io-backend ( -- DWORD )