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

change windows file-system-info implementation

db4
Doug Coleman 2008-10-19 18:19:15 -05:00
parent c9167e2ab2
commit f5f6c400db
2 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/io/windows/files/files.factor
View File

@ -246,12 +246,14 @@ M: winnt file-info ( path -- info )
M: winnt link-info ( path -- info ) M: winnt link-info ( path -- info )
file-info ; file-info ;
HOOK: root-directory os ( string -- string' )
TUPLE: winnt-file-system-info < file-system-info TUPLE: winnt-file-system-info < file-system-info
total-bytes total-free-bytes ; total-bytes total-free-bytes ;
M: winnt file-system-info ( path -- file-system-info ) M: winnt file-system-info ( path -- file-system-info )
normalize-path normalize-path root-directory
dup file-info directory? [ parent-directory ] unless dup
"ULARGE_INTEGER" <c-object> "ULARGE_INTEGER" <c-object>
"ULARGE_INTEGER" <c-object> "ULARGE_INTEGER" <c-object>
"ULARGE_INTEGER" <c-object> "ULARGE_INTEGER" <c-object>
@ -259,7 +261,8 @@ M: winnt file-system-info ( path -- file-system-info )
\ winnt-file-system-info new \ winnt-file-system-info new
swap *ulonglong >>total-free-bytes swap *ulonglong >>total-free-bytes
swap *ulonglong >>total-bytes swap *ulonglong >>total-bytes
swap *ulonglong >>free-space ; swap *ulonglong >>free-space
swap "\\\\?\\" ?head drop root-directory >>name ;
: file-times ( path -- timestamp timestamp timestamp ) : file-times ( path -- timestamp timestamp timestamp )
[ [

5
basis/io/windows/nt/files/files.factor
View File

@ -31,12 +31,13 @@ M: winnt root-directory? ( path -- ? )
ERROR: not-absolute-path ; ERROR: not-absolute-path ;
: root-directory ( string -- string' ) M: winnt root-directory ( string -- string' )
unicode-prefix ?head drop
dup { dup {
[ length 2 >= ] [ length 2 >= ]
[ second CHAR: : = ] [ second CHAR: : = ]
[ first Letter? ] [ first Letter? ]
} 1&& [ 2 head ] [ not-absolute-path ] if ; } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;
: prepend-prefix ( string -- string' ) : prepend-prefix ( string -- string' )
dup unicode-prefix head? [ dup unicode-prefix head? [