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

rename normalize-pathname to normalize-path 

fix windows launcher issue
db4
Doug Coleman 2008-04-01 19:51:49 -05:00
parent d3da0eb5ca
commit 2bad7228a7
16 changed files with 63 additions and 62 deletions

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

@ -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

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

@ -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

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" } }
{ $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 <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;

45
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 )
: <file-reader> ( path encoding -- stream )
swap normalize-pathname (file-reader) swap <decoder> ;
swap normalize-path (file-reader) swap <decoder> ;
: <file-writer> ( path encoding -- stream )
swap normalize-pathname (file-writer) swap <encoder> ;
swap normalize-path (file-writer) swap <encoder> ;
: <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-reader> 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 ;

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

@ -24,7 +24,7 @@ ERROR: cairo-error string ;
} cond ;
: <png> ( 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 ]

2
extra/editors/editors.factor
View File

@ -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 -- )

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

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

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
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 [ <byte-array> tuck ] [ ] bi readlink
dup io-error head-slice >string ;

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

@ -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 -- )

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 ;
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 )

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

@ -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" <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
[
>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 ;

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

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

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

@ -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

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

@ -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 ;

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

@ -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

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 -- )
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 <win32-file> <writer> ;
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 )