change windows file-system-info implementation
parent
c9167e2ab2
commit
f5f6c400db
|
@ -246,12 +246,14 @@ M: winnt file-info ( path -- info )
|
|||
M: winnt link-info ( path -- info )
|
||||
file-info ;
|
||||
|
||||
HOOK: root-directory os ( string -- string' )
|
||||
|
||||
TUPLE: winnt-file-system-info < file-system-info
|
||||
total-bytes total-free-bytes ;
|
||||
|
||||
M: winnt file-system-info ( path -- file-system-info )
|
||||
normalize-path
|
||||
dup file-info directory? [ parent-directory ] unless
|
||||
normalize-path root-directory
|
||||
dup
|
||||
"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
|
||||
swap *ulonglong >>total-free-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 )
|
||||
[
|
||||
|
|
|
@ -31,12 +31,13 @@ M: winnt root-directory? ( path -- ? )
|
|||
|
||||
ERROR: not-absolute-path ;
|
||||
|
||||
: root-directory ( string -- string' )
|
||||
M: winnt root-directory ( string -- string' )
|
||||
unicode-prefix ?head drop
|
||||
dup {
|
||||
[ length 2 >= ]
|
||||
[ second CHAR: : = ]
|
||||
[ first Letter? ]
|
||||
} 1&& [ 2 head ] [ not-absolute-path ] if ;
|
||||
} 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;
|
||||
|
||||
: prepend-prefix ( string -- string' )
|
||||
dup unicode-prefix head? [
|
||||
|
|
Loading…
Reference in New Issue