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

minor cleanup in windows path handling

db4
erg 2008-03-25 19:52:07 -05:00
parent b13e0f7042
commit 807c84918b
1 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,7 +2,8 @@ USING: continuations destructors io.buffers io.files io.backend
io.timeouts io.nonblocking io.windows io.windows.nt.backend io.timeouts io.nonblocking io.windows io.windows.nt.backend
kernel libc math threads windows windows.kernel32 kernel libc math threads windows windows.kernel32
alien.c-types alien.arrays sequences combinators combinators.lib alien.c-types alien.arrays sequences combinators combinators.lib
sequences.lib ascii splitting alien strings assocs ; sequences.lib ascii splitting alien strings assocs
combinators.cleave ;
IN: io.windows.nt.files IN: io.windows.nt.files
M: windows-nt-io cwd M: windows-nt-io cwd
@ -18,18 +19,19 @@ M: windows-nt-io cd
M: windows-nt-io root-directory? ( path -- ? ) M: windows-nt-io root-directory? ( path -- ? )
dup length 2 = [ dup length 2 = [
dup first Letter? first2
swap second CHAR: : = and [ Letter? ] [ CHAR: : = ] bi* and
] [ ] [
drop f drop f
] if ; ] if ;
ERROR: not-absolute-path ;
: root-directory ( string -- string' ) : root-directory ( string -- string' )
{ {
[ dup length 2 >= ] [ dup length 2 >= ]
[ dup second CHAR: : = ] [ dup second CHAR: : = ]
[ dup first Letter? ] [ dup first Letter? ]
} && [ 2 head ] [ "Not an absolute path" throw ] if ; } && [ 2 head ] [ not-absolute-path ] if ;
: prepend-prefix ( string -- string' ) : prepend-prefix ( string -- string' )
unicode-prefix prepend ; unicode-prefix prepend ;
@ -58,9 +60,12 @@ M: windows-nt-io root-directory? ( path -- ? )
] } ] }
} cond ; } cond ;
ERROR: nonstring-pathname ;
ERROR: empty-pathname ;
M: windows-nt-io normalize-pathname ( string -- string ) M: windows-nt-io normalize-pathname ( string -- string )
dup string? [ "Pathname must be a string" throw ] unless dup string? [ nonstring-pathname ] unless
dup empty? [ "Empty pathname" throw ] when dup empty? [ empty-pathname ] when
{ { CHAR: / CHAR: \\ } } substitute { { CHAR: / CHAR: \\ } } substitute
cwd swap windows-append-path cwd swap windows-append-path
[ "/\\." member? ] right-trim [ "/\\." member? ] right-trim