From a80e95ac2d65de8b96edfdbb638a06551cfbdf2b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 1 Apr 2008 18:02:39 -0500 Subject: [PATCH 1/3] fix using --- extra/classes/singleton/singleton-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/classes/singleton/singleton-tests.factor b/extra/classes/singleton/singleton-tests.factor index 453a2a0ea5..08f4a77aad 100644 --- a/extra/classes/singleton/singleton-tests.factor +++ b/extra/classes/singleton/singleton-tests.factor @@ -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 [ ] [ SINGLETON: bzzt ] unit-test From ae623ff9249632872cc85c69ecf3ade2797a47d0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 1 Apr 2008 19:00:20 -0500 Subject: [PATCH 2/3] normalize-pathname prepends unicode prefix, (normalize-pathname) does not --- core/io/backend/backend.factor | 2 +- core/io/files/files-tests.factor | 6 ----- core/io/files/files.factor | 13 ++++++--- extra/editors/editors.factor | 2 +- extra/io/unix/files/files-tests.factor | 6 +++++ extra/io/windows/launcher/launcher.factor | 2 +- extra/io/windows/nt/files/files-tests.factor | 9 ++++--- extra/io/windows/nt/files/files.factor | 28 +++++--------------- 8 files changed, 32 insertions(+), 36 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 6bcd448385..935b007dd5 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: init kernel system namespaces io io.encodings -io.encodings.utf8 init assocs ; +io.encodings.utf8 init assocs splitting ; IN: io.backend SYMBOL: io-backend diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 9920d8d25c..b4a7d44433 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -220,8 +220,6 @@ io.encodings.utf8 ; [ "/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 [ "/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/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/baz/.." parent-directory ] must-fail @@ -263,5 +258,4 @@ io.encodings.utf8 ; [ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test [ t ] [ "resource:core" absolute-path? ] unit-test -[ t ] [ "/foo" absolute-path? ] unit-test [ f ] [ "" absolute-path? ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 099acb157e..d2142cc6f3 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -102,6 +102,7 @@ PRIVATE> : windows-absolute-path? ( path -- path ? ) { + { [ dup "\\\\?\\" head? ] [ t ] } { [ dup length 2 < ] [ f ] } { [ dup second CHAR: : = ] [ t ] } { [ t ] [ f ] } @@ -111,8 +112,8 @@ PRIVATE> { { [ dup empty? ] [ f ] } { [ dup "resource:" head? ] [ t ] } - { [ dup first path-separator? ] [ t ] } { [ windows? ] [ windows-absolute-path? ] } + { [ dup first path-separator? ] [ t ] } { [ t ] [ f ] } } cond nip ; @@ -126,6 +127,9 @@ PRIVATE> 2 tail left-trim-separators >r parent-directory r> append-path ] } + { [ over absolute-path? over first path-separator? and ] [ + >r 2 head r> append + ] } { [ t ] [ >r right-trim-separators "/" r> left-trim-separators 3append @@ -296,14 +300,17 @@ DEFER: copy-tree-into : temp-file ( name -- path ) temp-directory prepend-path ; -M: object normalize-pathname ( path -- path' ) +: (normalize-pathname) ( path -- path' ) "resource:" ?head [ left-trim-separators resource-path - normalize-pathname + (normalize-pathname) ] [ current-directory get prepend-path ] if ; +M: object normalize-pathname ( path -- path' ) + (normalize-pathname) ; + ! Pathname presentations TUPLE: pathname string ; diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index c442dfaa94..00e20de5b5 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -26,7 +26,7 @@ SYMBOL: edit-hook require ; : edit-location ( file line -- ) - >r normalize-pathname "\\\\?\\" ?head drop r> + >r (normalize-pathname) "\\\\?\\" ?head drop r> edit-hook get [ call ] [ no-edit-hook edit-location ] if* ; : edit ( defspec -- ) diff --git a/extra/io/unix/files/files-tests.factor b/extra/io/unix/files/files-tests.factor index bb2039adfb..a0310a1cac 100755 --- a/extra/io/unix/files/files-tests.factor +++ b/extra/io/unix/files/files-tests.factor @@ -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" ] [ "/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? ] } diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 31247e43c3..f3226bfbf0 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -28,7 +28,7 @@ TUPLE: CreateProcess-args "PROCESS_INFORMATION" >>lpProcessInformation TRUE >>bInheritHandles 0 >>dwCreateFlags - current-directory get normalize-pathname >>lpCurrentDirectory ; + current-directory get (normalize-pathname) >>lpCurrentDirectory ; : call-CreateProcess ( CreateProcess-args -- ) { diff --git a/extra/io/windows/nt/files/files-tests.factor b/extra/io/windows/nt/files/files-tests.factor index 73d6a0bf7f..431aced65d 100644 --- a/extra/io/windows/nt/files/files-tests.factor +++ b/extra/io/windows/nt/files/files-tests.factor @@ -1,9 +1,9 @@ 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 -[ t ] [ "\\foo" absolute-path? ] unit-test -[ t ] [ "\\\\?\\foo" absolute-path? ] unit-test +[ f ] [ "\\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 @@ -45,3 +45,6 @@ IN: io.windows.nt.files.tests "C:\\builds\\factor\\12345\\" "..\\.." append-path normalize-pathname ] unit-test + +[ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test +[ t ] [ "" resource-path 2 tail exists? ] unit-test diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 81112a89c0..bc676b8d0a 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -36,28 +36,14 @@ ERROR: not-absolute-path ; } && [ 2 head ] [ not-absolute-path ] if ; : prepend-prefix ( string -- string' ) - unicode-prefix prepend ; + dup unicode-prefix head? [ + unicode-prefix prepend + ] unless ; -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 first path-separator? [ - left-trim-separators - current-directory get 2 head - prepend-path - ] when - unicode-prefix prepend - ] unless - { { CHAR: / CHAR: \\ } } substitute ! necessary - ] if ; +M: windows-nt-io normalize-pathname ( string -- string' ) + (normalize-pathname) + { { CHAR: / CHAR: \\ } } substitute + prepend-prefix ; M: windows-nt-io CreateFile-flags ( DWORD -- DWORD ) FILE_FLAG_OVERLAPPED bitor ; From 2bad7228a7df0496b240c2b4b5f7483b06b0d10e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 1 Apr 2008 19:51:49 -0500 Subject: [PATCH 3/3] rename normalize-pathname to normalize-path fix windows launcher issue --- core/io/backend/backend-tests.factor | 8 ++-- core/io/backend/backend.factor | 4 +- core/io/files/files-docs.factor | 2 +- core/io/files/files.factor | 45 ++++++++++---------- extra/cairo/png/png.factor | 2 +- extra/editors/editors.factor | 2 +- extra/io/sockets/sockets.factor | 2 +- extra/io/unix/files/files.factor | 20 ++++----- extra/io/unix/launcher/launcher.factor | 2 +- extra/io/windows/ce/files/files.factor | 2 +- extra/io/windows/files/files.factor | 8 ++-- extra/io/windows/launcher/launcher.factor | 2 +- extra/io/windows/nt/files/files-tests.factor | 8 ++-- extra/io/windows/nt/files/files.factor | 4 +- extra/io/windows/nt/launcher/launcher.factor | 2 +- extra/io/windows/windows.factor | 12 +++--- 16 files changed, 63 insertions(+), 62 deletions(-) mode change 100644 => 100755 core/io/backend/backend-tests.factor mode change 100644 => 100755 extra/io/windows/nt/files/files-tests.factor diff --git a/core/io/backend/backend-tests.factor b/core/io/backend/backend-tests.factor old mode 100644 new mode 100755 index 04f34068eb..c3d7e8e89b --- a/core/io/backend/backend-tests.factor +++ b/core/io/backend/backend-tests.factor @@ -1,4 +1,4 @@ -IN: io.backend.tests -USING: tools.test io.backend kernel ; - -[ ] [ "a" normalize-pathname drop ] unit-test +IN: io.backend.tests +USING: tools.test io.backend kernel ; + +[ ] [ "a" normalize-path drop ] unit-test diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 935b007dd5..44b1eea349 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -18,9 +18,9 @@ HOOK: io-multiplex io-backend ( ms -- ) 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 -- ) io-backend set-global init-io init-stdio diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 1953569223..342967acfc 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -252,7 +252,7 @@ HELP: normalize-directory { $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." } ; -HELP: normalize-pathname +HELP: normalize-path { $values { "str" "a pathname string" } { "newstr" "a new pathname string" } } { $description "Called by words such as " { $link } " and " { $link } " to prepare a pathname before passing it to underlying code." } ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index d2142cc6f3..720894d489 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -13,13 +13,13 @@ HOOK: (file-writer) io-backend ( path -- stream ) HOOK: (file-appender) io-backend ( path -- stream ) : ( path encoding -- stream ) - swap normalize-pathname (file-reader) swap ; + swap normalize-path (file-reader) swap ; : ( path encoding -- stream ) - swap normalize-pathname (file-writer) swap ; + swap normalize-path (file-writer) swap ; : ( path encoding -- stream ) - swap normalize-pathname (file-appender) swap ; + swap normalize-path (file-appender) swap ; : file-lines ( path encoding -- seq ) lines ; @@ -171,7 +171,7 @@ SYMBOL: +unknown+ ! File metadata : exists? ( path -- ? ) - normalize-pathname (exists?) ; + normalize-path (exists?) ; : directory? ( path -- ? ) file-info file-info-type +directory+ = ; @@ -187,18 +187,33 @@ M: object cwd ( -- path ) "." ; [ 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 -- ) - >r normalize-pathname r> + >r (normalize-path) r> current-directory swap with-variable ; inline : set-current-directory ( path -- ) - normalize-pathname current-directory set ; + normalize-path current-directory set ; ! Creating directories HOOK: make-directory io-backend ( path -- ) : make-directories ( path -- ) - normalize-pathname right-trim-separators { + normalize-path right-trim-separators { { [ dup "." = ] [ ] } { [ dup root-directory? ] [ ] } { [ dup empty? ] [ ] } @@ -271,7 +286,7 @@ M: object copy-file DEFER: copy-tree-into : copy-tree ( from to -- ) - normalize-pathname + normalize-path over link-info type>> { { +symbolic-link+ [ copy-link ] } @@ -290,9 +305,6 @@ DEFER: copy-tree-into [ copy-tree-into ] curry each ; ! Special paths -: resource-path ( path -- newpath ) - "resource-path" get [ image parent-directory ] unless* - prepend-path ; : temp-directory ( -- path ) "temp" resource-path dup make-directories ; @@ -300,17 +312,6 @@ DEFER: copy-tree-into : temp-file ( name -- path ) temp-directory prepend-path ; -: (normalize-pathname) ( path -- path' ) - "resource:" ?head [ - left-trim-separators resource-path - (normalize-pathname) - ] [ - current-directory get prepend-path - ] if ; - -M: object normalize-pathname ( path -- path' ) - (normalize-pathname) ; - ! Pathname presentations TUPLE: pathname string ; diff --git a/extra/cairo/png/png.factor b/extra/cairo/png/png.factor index 774a1afe8e..f9908e4581 100755 --- a/extra/cairo/png/png.factor +++ b/extra/cairo/png/png.factor @@ -24,7 +24,7 @@ ERROR: cairo-error string ; } cond ; : ( path -- png ) - normalize-pathname + normalize-path cairo_image_surface_create_from_png dup cairo_surface_status cairo-png-error dup [ cairo_image_surface_get_width check-zero ] diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index 00e20de5b5..e871d5f808 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -26,7 +26,7 @@ SYMBOL: edit-hook require ; : 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 ( defspec -- ) diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index e1cc36cd2e..17799227b8 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -7,7 +7,7 @@ IN: io.sockets TUPLE: local path ; : ( path -- addrspec ) - normalize-pathname local construct-boa ; + normalize-path local construct-boa ; TUPLE: inet4 host port ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index c4e506d37f..7d0e7c4330 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -43,22 +43,22 @@ M: unix-io (file-appender) ( path -- stream ) { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable M: unix-io touch-file ( path -- ) - normalize-pathname + normalize-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 -- ) - [ normalize-pathname ] bi@ rename io-error ; + [ normalize-path ] bi@ rename io-error ; M: unix-io delete-file ( path -- ) - normalize-pathname unlink io-error ; + normalize-path unlink io-error ; 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 -- ) - normalize-pathname rmdir io-error ; + normalize-path rmdir io-error ; : (copy-file) ( from to -- ) dup parent-directory make-directories @@ -69,7 +69,7 @@ M: unix-io delete-directory ( path -- ) ] with-disposal ; M: unix-io copy-file ( from to -- ) - [ normalize-pathname ] bi@ + [ normalize-path ] bi@ [ (copy-file) ] [ swap file-info file-info-permissions chmod io-error ] 2bi ; @@ -96,15 +96,15 @@ M: unix-io copy-file ( from to -- ) \ file-info construct-boa ; 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 ) - normalize-pathname lstat* stat>file-info ; + normalize-path lstat* stat>file-info ; M: unix-io make-link ( path1 path2 -- ) - normalize-pathname symlink io-error ; + normalize-path symlink io-error ; M: unix-io read-link ( path -- path' ) - normalize-pathname + normalize-path PATH_MAX [ tuck ] [ ] bi readlink dup io-error head-slice >string ; diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index f738bd42c2..4986024e78 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -37,7 +37,7 @@ USE: unix 2nip reset-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 ; : redirect-closed ( obj mode fd -- ) diff --git a/extra/io/windows/ce/files/files.factor b/extra/io/windows/ce/files/files.factor index c4f5b2ef9e..1e5cedae57 100755 --- a/extra/io/windows/ce/files/files.factor +++ b/extra/io/windows/ce/files/files.factor @@ -4,7 +4,7 @@ prettyprint sequences strings threads threads.private windows windows.kernel32 io.windows.ce.backend ; 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 ; M: windows-ce-io CreateFile-flags ( DWORD -- DWORD ) diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 295b3ab006..a23a78b3da 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -89,14 +89,14 @@ SYMBOLS: +read-only+ +hidden+ +system+ ] if ; 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 ) file-info ; : file-times ( path -- timestamp timestamp timestamp ) [ - normalize-pathname open-existing dup close-always + normalize-path open-existing dup close-always "FILETIME" "FILETIME" "FILETIME" @@ -112,7 +112,7 @@ M: windows-nt-io link-info ( path -- info ) #! timestamp order: creation access write [ >r >r >r - normalize-pathname open-existing dup close-always + normalize-path open-existing dup close-always r> r> r> (set-file-times) ] with-destructors ; @@ -127,7 +127,7 @@ M: windows-nt-io link-info ( path -- info ) M: windows-nt-io touch-file ( path -- ) [ - normalize-pathname + normalize-path maybe-create-file over close-always [ drop ] [ f now dup (set-file-times) ] if ] with-destructors ; diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index f3226bfbf0..579745710e 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -28,7 +28,7 @@ TUPLE: CreateProcess-args "PROCESS_INFORMATION" >>lpProcessInformation TRUE >>bInheritHandles 0 >>dwCreateFlags - current-directory get (normalize-pathname) >>lpCurrentDirectory ; + current-directory get (normalize-path) >>lpCurrentDirectory ; : call-CreateProcess ( CreateProcess-args -- ) { diff --git a/extra/io/windows/nt/files/files-tests.factor b/extra/io/windows/nt/files/files-tests.factor old mode 100644 new mode 100755 index 431aced65d..1e6268fbc0 --- a/extra/io/windows/nt/files/files-tests.factor +++ b/extra/io/windows/nt/files/files-tests.factor @@ -29,21 +29,21 @@ IN: io.windows.nt.files.tests [ ] [ "" 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\\12345\\" - "..\\log.txt" append-path normalize-pathname + "..\\log.txt" append-path normalize-path ] unit-test [ "\\\\?\\C:\\builds\\" ] [ "C:\\builds\\factor\\12345\\" - "..\\.." append-path normalize-pathname + "..\\.." append-path normalize-path ] unit-test [ "\\\\?\\C:\\builds\\" ] [ "C:\\builds\\factor\\12345\\" - "..\\.." append-path normalize-pathname + "..\\.." append-path normalize-path ] unit-test [ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index bc676b8d0a..91ad0139b2 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -40,8 +40,8 @@ ERROR: not-absolute-path ; unicode-prefix prepend ] unless ; -M: windows-nt-io normalize-pathname ( string -- string' ) - (normalize-pathname) +M: windows-nt-io normalize-path ( string -- string' ) + (normalize-path) { { CHAR: / CHAR: \\ } } substitute prepend-prefix ; diff --git a/extra/io/windows/nt/launcher/launcher.factor b/extra/io/windows/nt/launcher/launcher.factor index c342b2ee9a..895890e898 100755 --- a/extra/io/windows/nt/launcher/launcher.factor +++ b/extra/io/windows/nt/launcher/launcher.factor @@ -32,7 +32,7 @@ IN: io.windows.nt.launcher drop 2nip null-pipe ; :: redirect-file ( default path access-mode create-mode -- handle ) - path normalize-pathname + path normalize-path access-mode share-mode security-attributes-inherit diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 27917cedfa..45c1adaf50 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -25,7 +25,7 @@ HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: add-completion io-backend ( port -- ) M: windows-io normalize-directory ( string -- string ) - normalize-pathname "\\" ?tail drop "\\*" append ; + normalize-path "\\" ?tail drop "\\*" append ; : share-mode ( -- fixnum ) { @@ -135,21 +135,21 @@ M: windows-io (file-appender) ( path -- stream ) open-append ; 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 -- ) - normalize-pathname DeleteFile win32-error=0/f ; + normalize-path DeleteFile win32-error=0/f ; M: windows-io copy-file ( from to -- ) 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 -- ) - normalize-pathname + normalize-path f CreateDirectory win32-error=0/f ; M: windows-io delete-directory ( path -- ) - normalize-pathname + normalize-path RemoveDirectory win32-error=0/f ; HOOK: WSASocket-flags io-backend ( -- DWORD )